{ GRAEDITOR.PAS Copyright (c) Martin Kolecek } { Program editor umoznuje vytvaret, ukladat i nacitat z disku } { graficke soubory s priponou gra. Jedna se o muj vlastni format } { ve kterem je zakodovana grafika 160x200 pixelu s barevnou hloubkou} { 16 barev vybranych ze 65535ti. Vysledny graficky soubor zabira } { 9048 bajtu takze je vhodny pro prilinkovavani napr. do her v } { assembleru. } { } { prvnich 8000 bajtu je grafika 160x200 (viz rozkodovani) } { obsahuje same hodnoty 0 1 2 3 } { } { dalsich 1000 bajtu obsahuje ctverice bajtu pro kazdy ctverecek 8x8} { pixelu - zde uz jsou nahrany barvy 0-15 } { } { poslednich 48 bajtu obsahuje barevnou paletu pro prvnich 16 barev.} { } { V programu je pouzito zakodovani a rozkodovani. Po rozkodovani } { zabira stranka 160x200x16 32KB zakodovana 9KB. } { } { K zakodovani je pouzito prevodu decadickych cisel na binarni. } { Takze 4 pixely zabiraji presne jeden bajt. 00 01 10 11 b } { } { Program obsahuje napovedu ve ktere je ovladani editoru. } { Vse je na klavesnici. } { } { Zname chyby: kdyz se otevira soubor a zada se jmeno neexistujuciho} { souboru nebo nejak spatne dojde k padu programu (chybi File not } { found funkce) } { druha znama chyba: v casti editoru kde se pracuje se schrankou se } { obsah schranky napravo zobrazuje spatne ale jinak schranka funguje} { } { Author: Martin Kolecek } { Datum: 12.05.2009 http://www.trsek.com } Program Editor; Uses CRT,DOS; Type TRGB= Record R: Byte; G: Byte; B: Byte; End; Const FileNamePripona: string[4] = '.gra'; Var MMSelect: Byte; PalSelect: Byte; B4X,B4Y: Byte; B4X2,B4Y2: Byte; B4X3,B4Y3: Integer; EX,EY: Byte; EX2,EY2: Byte; Xs,Ys: Integer; Color: array[0..3] of Byte; F: File; DirInfo: SearchRec; FileName: string[12]; FileNameJmeno: string[8]; FileNameDialogOK:Boolean; CisloStranky: Byte; Clipboard: array[0..63] of Byte; {64B 8x8} {0..3} Clipboard2: array[0..3] of Byte; {barvy 4} {0..15} Grafika: array[0..7999] of Byte; Barvy4: array[0..999] of Byte; Paleta: array[0..47] of Byte; Barva: array[0..15] of TRGB; Buffer32,Buffer2: Pointer; BufferSeg32,BufferSeg2: Word; a7,a6,a5,a4,a3,a2,a1,a0: Byte; b7,b6,b5,b4,b3,b2,b1,b0: Byte; {XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX} Procedure NoBeep; Begin While KeyPressed do ReadKey; End; Procedure Init320x200; Assembler; Asm Mov AH, 00h Mov AL, 13h Int 10h End; Procedure Init80x25; Assembler; Asm Mov AH, 00h Mov AL, 03h Int 10h End; Procedure WaitRetrace; Assembler; Asm Mov dx,3DAh @l1: In al,dx And al,08h Jnz @l1 @l2: In al,dx And al,08h Jz @l2 End; Procedure WritePixel (X:Word;Y,Barva:Byte); Begin Mem[$A000:Y*320+X]:=Barva; End; Procedure Blok(x1,y1,x2,y2,Barva:Word); Var x,y: Word; Begin For y:=y1 to y2 do For x:=x1 to x2 do WritePixel(x,y,Barva); End; Procedure Ramecek (X1,Y1,X2,Y2,Barva: Word); Var DelkaX,DelkaY,I: Word; Begin DelkaX := X2-X1; DelkaY := Y2-Y1; For I := 0 to DelkaX do WritePixel (X1+I,Y1,Barva); For I := 0 to DelkaX do WritePixel (X1+I,Y2,Barva); For I := 0 to DelkaY do WritePixel (X1,Y1+I,Barva); For I := 0 to DelkaY do WritePixel (X2,Y1+I,Barva); End; Procedure GetPal(Color:Byte; Var R,G,B:Byte); Begin Port[$3c7]:=Color; R:=Port[$3c9]; G:=Port[$3c9]; B:=Port[$3c9]; End; Function GetPalR(Color:Byte): Byte; Var R,G,B: Byte; Begin Port[$3c7]:=Color; R:=Port[$3c9]; G:=Port[$3c9]; B:=Port[$3c9]; GetPalR:=R; End; Function GetPalG(Color:Byte): Byte; Var R,G,B: Byte; Begin Port[$3c7]:=Color; R:=Port[$3c9]; G:=Port[$3c9]; B:=Port[$3c9]; GetPalG:=G; End; Function GetPalB(Color:Byte): Byte; Var R,G,B: Byte; Begin Port[$3c7]:=Color; R:=Port[$3c9]; G:=Port[$3c9]; B:=Port[$3c9]; GetPalB:=B; End; Procedure SetPal(Color:Byte; R,G,B:Byte); Begin Port[$3c8]:=Color; Port[$3c9]:=R; Port[$3c9]:=G; Port[$3c9]:=B; End; Procedure SoundStorno; Var I,I2:Word; Begin I2:=350; For I:=0 to 3 do Begin Sound(I2); Delay(20); NoSound; Dec(I2,50); End; End; Procedure SoundDone; Var I,I2:Word; Begin I2:=200; For I:=0 to 5 do Begin Sound(I2); Delay(20); NoSound; Inc(I2,50); End; End; Procedure InitBuffers; Var I: Word; Begin GetMem(Buffer32,32000); BufferSeg32:=Seg(Buffer32^); GetMem(Buffer2,2000); BufferSeg2:=Seg(Buffer2^); For I:=0 to 31999 do mem[BufferSeg32:I]:=0; {vymaz bufferu} For I:=0 to 1999 do mem[BufferSeg2:I]:=0; {vymaz bufferu} End; Procedure ShutdownBuffers; Begin FreeMem(Buffer32,32000); FreeMem(Buffer2,2000); End; Function Bin2Dec(b7,b6,b5,b4,b3,b2,b1,b0: Byte): Byte; Var I: Byte; Begin I:=0; If b7=1 then Inc(I,128); If b6=1 then Inc(I,64); If b5=1 then Inc(I,32); If b4=1 then Inc(I,16); If b3=1 then Inc(I,8); If b2=1 then Inc(I,4); If b1=1 then Inc(I,2); If b0=1 then Inc(I,1); Bin2Dec:=I; End; Procedure Dec2Bin(DCnum:Byte); Begin If DCnum>=128 then Begin b7:=1; Dec(DCnum,128); End else b7:=0; If DCnum>=64 then Begin b6:=1; Dec(DCnum,64); End else b6:=0; If DCnum>=32 then Begin b5:=1; Dec(DCnum,32); End else b5:=0; If DCnum>=16 then Begin b4:=1; Dec(DCnum,16); End else b4:=0; If DCnum>=8 then Begin b3:=1; Dec(DCnum,8); End else b3:=0; If DCnum>=4 then Begin b2:=1; Dec(DCnum,4); End else b2:=0; If DCnum>=2 then Begin b1:=1; Dec(DCnum,2); End else b1:=0; If DCnum>=1 then Begin b0:=1; Dec(DCnum,1); End else b0:=0; End; Procedure Zakodovat; Var A,I: Word; Begin A:=0; I:=0; Repeat Dec2Bin(mem[BufferSeg32:A+0]); a0:=b0; a1:=b1; Dec2Bin(mem[BufferSeg32:A+1]); a2:=b0; a3:=b1; Dec2Bin(mem[BufferSeg32:A+2]); a4:=b0; a5:=b1; Dec2Bin(mem[BufferSeg32:A+3]); a6:=b0; a7:=b1; Grafika[I]:=Bin2Dec(a7,a6,a5,a4,a3,a2,a1,a0); Inc(A,4); Inc(I); Until I=8000; A:=0; I:=0; Repeat Dec2Bin(mem[BufferSeg2:A+0]); a0:=b0; a1:=b1; a2:=b2; a3:=b3; Dec2Bin(mem[BufferSeg2:A+1]); a4:=b0; a5:=b1; a6:=b2; a7:=b3; Barvy4[I]:=Bin2Dec(a7,a6,a5,a4,a3,a2,a1,a0); Inc(A,2); Inc(I); Until I=1000; A:=0; For I:=0 to 15 do Begin Paleta[A+0]:=Barva[I].R; Paleta[A+1]:=Barva[I].G; Paleta[A+2]:=Barva[I].B; Inc(A,3); End; End; Procedure Rozkodovat; Var A,I: Word; Begin A:=0; I:=0; Repeat Dec2Bin(Grafika[I]); mem[BufferSeg32:A+0]:=Bin2Dec(0,0,0,0,0,0,b1,b0); mem[BufferSeg32:A+1]:=Bin2Dec(0,0,0,0,0,0,b3,b2); mem[BufferSeg32:A+2]:=Bin2Dec(0,0,0,0,0,0,b5,b4); mem[BufferSeg32:A+3]:=Bin2Dec(0,0,0,0,0,0,b7,b6); Inc(A,4); Inc(I); Until I=8000; A:=0; I:=0; Repeat Dec2Bin(Barvy4[I]); mem[BufferSeg2:A+0]:=Bin2Dec(0,0,0,0,b3,b2,b1,b0); mem[BufferSeg2:A+1]:=Bin2Dec(0,0,0,0,b7,b6,b5,b4); Inc(A,2); Inc(I); Until I=1000; A:=0; For I:=0 to 15 do Begin Barva[I].R:=Paleta[A+0]; Barva[I].G:=Paleta[A+1]; Barva[I].B:=Paleta[A+2]; Inc(A,3); End; End; Procedure FnSave; Begin Assign(F,Filename); Reset(F,1); Zakodovat; BlockWrite(F,Grafika,8000); BlockWrite(F,Barvy4,1000); BlockWrite(F,Paleta,48); BlockWrite(F,CisloStranky,1); Close(F); SoundDone; End; Procedure PrepareColors; Var I: Byte; Begin SetPal(251,0,0,0); {Black} SetPal(252,63,63,63); {White} SetPal(253,63,0,0); {Red} SetPal(254,0,63,0); {Green} SetPal(255,0,0,63); {Blue} For I:=0 to 15 do SetPal(I,Barva[I].R,Barva[I].G,Barva[I].B); End; {XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX} Procedure WriteEPScreen; Var x,y,I: Word; Begin {Nastaveni palety} For I:=0 to 15 do SetPal(I,Barva[I].R,Barva[I].G,Barva[I].B); {Oramovani} x:=0; y:=0; Ramecek(x,y,x+319,y+199,252); {Editovana barva} x:=140; y:=50; Ramecek(x,y,x+100,y+100,252); Blok(x+2,y+2,x+98,y+98,PalSelect); {Barvy + mazani kurzoru} x:=12; y:=10; For I:=0 to 15 do Begin Blok(x,y,x+7,y+7,I); Ramecek(x-2,y-2,x+9,y+9,252); Ramecek(x-4,y-4,x+11,y+11,251); Ramecek(x-6,y-6,x+13,y+13,251); Inc(x,19); End; {Kurzor} x:=12; y:=10; I:=0; While I0 then Dec(PalSelect) else PalSelect:=15; End; {Right} 77: Begin If PalSelect<15 then Inc(PalSelect) else PalSelect:=0; End; {Insert} 82: Begin If Barva[PalSelect].R>0 then Dec(Barva[PalSelect].R) else Barva[PalSelect].R:=0; End; {Delete} 83: Begin If Barva[PalSelect].R<63 then Inc(Barva[PalSelect].R) else Barva[PalSelect].R:=63; End; {Home} 71: Begin If Barva[PalSelect].G>0 then Dec(Barva[PalSelect].G) else Barva[PalSelect].G:=0; End; {End} 79: Begin If Barva[PalSelect].G<63 then Inc(Barva[PalSelect].G) else Barva[PalSelect].G:=63; End; {PageUp} 73: Begin If Barva[PalSelect].B>0 then Dec(Barva[PalSelect].B) else Barva[PalSelect].B:=0; End; {PageDown} 81: Begin If Barva[PalSelect].B<63 then Inc(Barva[PalSelect].B) else Barva[PalSelect].B:=63; End; {F2} 60: Begin FnSave; End; {F8} 66: Begin SoundStorno; End; {F7} 65: Begin SoundStorno; End; {F6} 64: Begin SoundStorno; End; {F5} 63: Begin Ending:=True; End; {Esc} 1: Begin Ending:=True; End; End; {Case Port[$60] End} Until Ending=True; Blok(0,0,319,199,251); End; {XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX} Procedure Setup4Colors; Var I,X,Y,Offset: Word; Begin X:=Trunc((EX*8+EX2)/8); Y:=Trunc((EY*8+EY2)/8); Offset:=(Y*20+X)*4; For I:=0 to 3 do Color[I]:=mem[BufferSeg2:Offset+I]; End; Procedure WriteGScreen; Var I,Xa,Ya,x,y,X1,Y1,Xp,Yp,Offset32,Offset2: Word; Begin Ramecek(160,160,319,199,252); {Nastaveni spravnych barev 160x200 po krocich 8x8} For Ya:=0 to 24 do For Xa:=0 to 19 do Begin For y:=0 to 7 do For x:=0 to 7 do Begin X1:=Trunc((Xa*8+x)/8); Y1:=Trunc((Ya*8+y)/8); Offset2:=(Y1*20+X1)*4; Offset32:=((Ya*8+y)*160)+(Xa*8+x); Case mem[BufferSeg32:Offset32] of 0: WritePixel((Xa*8+x),(Ya*8+y),mem[BufferSeg2:Offset2+0]); 1: WritePixel((Xa*8+x),(Ya*8+y),mem[BufferSeg2:Offset2+1]); 2: WritePixel((Xa*8+x),(Ya*8+y),mem[BufferSeg2:Offset2+2]); 3: WritePixel((Xa*8+x),(Ya*8+y),mem[BufferSeg2:Offset2+3]); End; {Case End} End; End; {Kurzor 40x40} x:=EX*8; y:=EY*8; Ramecek(x,y,x+39,y+39,252); {Vykresleni obsahu 40x40} x:=160; y:=0; For Y1:=0 to 39 do Begin x:=160; For X1:=0 to 39 do Begin Xp:=Trunc((EX*8+X1)/8); Yp:=Trunc((EY*8+Y1)/8); Offset2:=(Yp*20+Xp)*4; Offset32:=(EY*8+Y1)*160+(EX*8+X1); Case mem[BufferSeg32:Offset32] of 0: Blok(x+1,y+1,x+2,y+2,mem[BufferSeg2:Offset2+0]); 1: Blok(x+1,y+1,x+2,y+2,mem[BufferSeg2:Offset2+1]); 2: Blok(x+1,y+1,x+2,y+2,mem[BufferSeg2:Offset2+2]); 3: Blok(x+1,y+1,x+2,y+2,mem[BufferSeg2:Offset2+3]); End; {Case End;} Inc(x,4); End; Inc(y,4); End; {Vymazavani kurzoru v editacnim poli} For Ya:=0 to 39 do For Xa:=0 to 39 do Begin x:=Xa*4+160; y:=Ya*4; Ramecek(x,y,x+3,y+3,251); End; {Kurzor v editacnim poli} x:=EX2*4+160; y:=EY2*4; Ramecek(x,y,x+3,y+3,252); {4 kreslici barvy ASDF} x:=160; y:=160; For I:=0 to 3 do Begin Ramecek(x,y,x+39,y+39,252); Blok(x+1,y+1,x+38,y+38,Color[I]); Inc(x,40); End; End; Procedure EditorGrafiky; Var Ending: Boolean; Begin EX:=0; EY:=0; EX2:=0; EY2:=0; Ending:=False; Blok(0,0,319,199,251); Repeat Setup4Colors; WaitRetrace; WriteGScreen; ReadKey; Delay(100); NoBeep; Case Port[$60] of {J} 36: Begin If EX2>0 then Dec(EX2) else EX2:=39; End; {L} 38: Begin If EX2<39 then Inc(EX2) else EX2:=0; End; {I} 23: Begin If EY2>0 then Dec(EY2) else EY2:=39; End; {K} 37: Begin If EY2<39 then Inc(EY2) else EY2:=0; End; {A} 30: Begin mem[BufferSeg32:((EY*8+EY2)*160)+(EX*8+EX2)]:=0; End; {S} 31: Begin mem[BufferSeg32:((EY*8+EY2)*160)+(EX*8+EX2)]:=1; End; {D} 32: Begin mem[BufferSeg32:((EY*8+EY2)*160)+(EX*8+EX2)]:=2; End; {F} 33: Begin mem[BufferSeg32:((EY*8+EY2)*160)+(EX*8+EX2)]:=3; End; {Left} 75: Begin If EX>0 then Dec(EX) else EX:=15; End; {Right} 77: Begin If EX<15 then Inc(EX) else EX:=0; End; {Up} 72: Begin If EY>0 then Dec(EY) else EY:=20; End; {Down} 80: Begin If EY<20 then Inc(EY) else EY:=0; End; {F2} 60: Begin FnSave; End; {F8} 66: Begin SoundStorno; End; {F7} 65: Begin SoundStorno; End; {F6} 64: Begin SoundStorno; End; {F5} 63: Begin Ending:=True; End; {Esc} 1: Begin Ending:=True; End; End; {Case Port[$60] End} Until Ending=True; Blok(0,0,319,199,251); End; {XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX} Procedure WriteE4Screen; Var x,y,X1,Y1,I,I2: Word; Begin Ramecek(160,0,319,199,252); {Vymazavani kurzoru - vyber barvy} x:=160; y:=0; I:=0; For Y1:=0 to 3 do Begin x:=160; For X1:=0 to 3 do Begin Ramecek(x+2,y+2,x+37,y+37,251); Blok(x+6,y+6,x+33,y+33,I); inc(x,40); Inc(I); End; Inc(y,40); End; {Kurzor - vyber barvy} x:=160+B4X2*40; y:=B4Y2*40; Ramecek(x+2,y+2,x+37,y+37,252); {nahled 4 vybranych barev} x:=160; y:=160; For I:=0 to 3 do Begin Ramecek(x,y,x+39,y+39,252); Blok(x+2,y+2,x+37,y+37,mem[BufferSeg2:B4Y3*20+B4X3+I]); Inc(x,40); End; {Vymazavani kurzoru a vykresleni 4barvy} x:=0; y:=0; I:=0; For Y1:=0 to 24 do Begin x:=0; For X1:=0 to 19 do Begin Ramecek(x,y,x+7,y+7,251); Blok(x+2,y+2,x+3,y+3,mem[BufferSeg2:I+0]); Blok(x+4,y+2,x+5,y+3,mem[BufferSeg2:I+1]); Blok(x+2,y+4,x+3,y+5,mem[BufferSeg2:I+2]); Blok(x+4,y+4,x+5,y+5,mem[BufferSeg2:I+3]); inc(x,8); Inc(I,4); End; Inc(y,8); End; {Kurzor} x:=B4X*8; y:=B4Y*8; Ramecek(x,y,x+7,y+7,252); End; Procedure Editor4Barvy; Var Ending: Boolean; I: Word; Begin B4X:=0; B4Y:=0; B4X2:=0; B4Y2:=0; B4X3:=0; B4Y3:=0; Ending:=False; Blok(0,0,319,199,251); Repeat WaitRetrace; WriteE4Screen; ReadKey; Delay(100); NoBeep; Case Port[$60] of {J} 36: Begin If B4X>0 then Dec(B4X) else B4X:=19; If B4X3>0 then Dec(B4X3,4) else B4X3:=76; End; {L} 38: Begin If B4X<19 then Inc(B4X) else B4X:=0; If B4X3<76 then Inc(B4X3,4) else B4X3:=0; End; {I} 23: Begin If B4Y>0 then Dec(B4Y) else B4Y:=24; If B4Y3>0 then Dec(B4Y3,4) else B4Y3:=96; End; {K} 37: Begin If B4Y<24 then Inc(B4Y) else B4Y:=0; If B4Y3<96 then Inc(B4Y3,4) else B4Y3:=0; End; {A} 30: Begin mem[BufferSeg2:(B4Y3*20+B4X3)+0]:=B4Y2*4+B4X2; End; {S} 31: Begin mem[BufferSeg2:(B4Y3*20+B4X3)+1]:=B4Y2*4+B4X2; End; {D} 32: Begin mem[BufferSeg2:(B4Y3*20+B4X3)+2]:=B4Y2*4+B4X2; End; {F} 33: Begin mem[BufferSeg2:(B4Y3*20+B4X3)+3]:=B4Y2*4+B4X2; End; {Left} 75: Begin If B4X2>0 then Dec(B4X2) else B4X2:=3; End; {Right} 77: Begin If B4X2<3 then Inc(B4X2) else B4X2:=0; End; {Up} 72: Begin If B4Y2>0 then Dec(B4Y2) else B4Y2:=3; End; {Down} 80: Begin If B4Y2<3 then Inc(B4Y2) else B4Y2:=0; End; {F2} 60: Begin FnSave; End; {F8} 66: Begin SoundStorno; End; {F7} 65: Begin SoundStorno; End; {F6} 64: Begin SoundStorno; End; {F5} 63: Begin Ending:=True; End; {Esc} 1: Begin Ending:=True; End; End; {Case Port[$60] End} Until Ending=True; Blok(0,0,319,199,251); End; {XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX} Procedure Copy2ClipBoard; Var Offset32,Offset2,X1,Y1,Xe,Ye,x,y,I: Word; Begin {kopirovani do schranky 64B 8x8} x:=Xs*8; y:=Ys*8; I:=0; For Ye:=0 to 7 do Begin For Xe:=0 to 7 do Begin Offset32:=((y+Ye)*160)+(x+Xe); Clipboard[I]:=mem[BufferSeg32:Offset32]; Inc(I); End; End; {kopirovani do schranky barvy 4} x:=0; y:=0; X1:=Trunc((Xs*8+x)/8); Y1:=Trunc((Ys*8+y)/8); Offset2:=(Y1*20+X1)*4; For I:=0 to 3 do Clipboard2[I]:=mem[BufferSeg2:Offset2+I]; End; Procedure RestoreFromClipBoard; Var Offset32,Offset2,X1,Y1,Xe,Ye,x,y,I: Word; Begin {vylozeni ze schranky 64B} x:=Xs*8; y:=Ys*8; I:=0; For Ye:=0 to 7 do Begin For Xe:=0 to 7 do Begin Offset32:=((y+Ye)*160)+(x+Xe); mem[BufferSeg32:Offset32]:=Clipboard[I]; Inc(I); End; End; {vylozeni ze schranky barvy 4} x:=0; y:=0; X1:=Trunc((Xs*8+x)/8); Y1:=Trunc((Ys*8+y)/8); Offset2:=(Y1*20+X1)*4; For I:=0 to 3 do mem[BufferSeg2:Offset2+I]:=Clipboard2[I]; End; Procedure WriteEScreen; Var Offset32,Offset2,Xa,Ya,X1,Y1,x,y,I,BarvaVeSchrance: Word; Begin Ramecek(160,0,319,199,252); {Nastaveni spravnych barev 160x200 po krocich 8x8} For Ya:=0 to 24 do For Xa:=0 to 19 do Begin For y:=0 to 7 do For x:=0 to 7 do Begin X1:=Trunc((Xa*8+x)/8); Y1:=Trunc((Ya*8+y)/8); Offset2:=(Y1*20+X1)*4; Offset32:=((Ya*8+y)*160)+(Xa*8+x); Case mem[BufferSeg32:Offset32] of 0: WritePixel((Xa*8+x),(Ya*8+y),mem[BufferSeg2:Offset2+0]); 1: WritePixel((Xa*8+x),(Ya*8+y),mem[BufferSeg2:Offset2+1]); 2: WritePixel((Xa*8+x),(Ya*8+y),mem[BufferSeg2:Offset2+2]); 3: WritePixel((Xa*8+x),(Ya*8+y),mem[BufferSeg2:Offset2+3]); End; {Case End} End; End; {Kurzor 8x8} x:=Xs*8; y:=Ys*8; Ramecek(x,y,x+7,y+7,252); {zobrazeni obsahu schranky - nahled barev} x:=194; y:=140; For I:=0 to 3 do Begin Blok(x,y,x+9,y+9,ClipBoard2[I]); Inc(x,10); End; {zobrazeni obsahu schranky - 8x8} Ramecek(194,49,276,131,252); x:=195; y:=50; I:=0; For Y1:=0 to 7 do Begin For X1:=0 to 7 do Begin Case Clipboard[I] of 0: BarvaVeSchrance:=Clipboard2[0]; 1: BarvaVeSchrance:=Clipboard2[1]; 2: BarvaVeSchrance:=Clipboard2[2]; 3: BarvaVeSchrance:=Clipboard2[3]; End; Blok(x+1,y+1,x+9,y+9,BarvaVeSchrance); inc(x,10); Inc(I); End; x:=195; Inc(y,10); End; End; Procedure FnEditor; Var Ending: Boolean; Begin Init320x200; PrepareColors; Ending:=False; Repeat WaitRetrace; WriteEScreen; ReadKey; Delay(100); NoBeep; Case Port[$60] of {Left} 75: Begin If Xs>0 then Dec(Xs) else Xs:=19; End; {Right} 77: Begin If Xs<19 then Inc(Xs) else Xs:=0; End; {Up} 72: Begin If Ys>0 then Dec(Ys) else Ys:=24; End; {Down} 80: Begin If Ys<24 then Inc(Ys) else Ys:=0; End; {C} 46: Begin Copy2ClipBoard; End; {V} 47: Begin RestoreFromClipBoard; End; {F2} 60: Begin FnSave; End; {F6} 64: Begin EditorGrafiky; End; {F7} 65: Begin Editor4Barvy; End; {F8} 66: Begin EditorPalety; End; {Esc} 1: Begin Ending:=True; End; End; {Case Port[$60] End} Until Ending=True; Init80x25; End; Procedure LoadError(CisloChyby:Byte); Var ErrorMSG: array[1..8] of String; X,Y,I,I2:Byte; Begin ErrorMSG[1]:='Nenalezen soubor'; ErrorMSG[2]:='Nenalezena cesta'; ErrorMSG[3]:='Přístup zamítnut'; ErrorMSG[4]:='Neplatný deskriptor'; ErrorMSG[5]:='Nedostatek paměti'; ErrorMSG[6]:='Neplatné prostředí'; ErrorMSG[7]:='Neplatný formát'; ErrorMSG[8]:='Soubor nenalezen'; {Vypisujeme Error MSG yellow} X:=27; Y:=12; {souradnice ErrorMSG} TextColor(14); {Zluty ramecek ErrorMSG} For I:=0 to 22 do Begin GotoXY(X+I,Y); Write('▄'); End; For I:=0 to 22 do Begin GotoXY(X+I,Y+3); Write('▀'); End; GotoXY(X,Y+1); Write('█'); GotoXY(X+22,Y+1); Write('█'); GotoXY(X,Y+2); Write('█'); GotoXY(X+22,Y+2); Write('█'); TextBackground(4); {Cervene pozadi ramecku} For I2:=1 to 2 do {vypln} For I:=0 to 20 do Begin GotoXY(X+1+I,Y+I2); Write(' '); End; GotoXY(X+2,Y+1); Write('CHYBA ESC=EXIT'); {Vypisujeme vzniklou chybu} GotoXY(X+2,Y+2); Case CisloChyby of 1: Write(ErrorMSG[1]); 2: Write(ErrorMSG[2]); 3: Write(ErrorMSG[3]); 4: Write(ErrorMSG[4]); 5: Write(ErrorMSG[5]); 6: Write(ErrorMSG[6]); 7: Write(ErrorMSG[7]); 8: Write(ErrorMSG[8]); End; Repeat Until Port[$60]=1; {Cekej na ESC} TextColor(7); TextBackground(0); {Set puvodni} GotoXY(X,Y); ClrEol; {Smazat ErrorMSG Okno} GotoXY(X,Y+1); ClrEol; {Smazat ErrorMSG Okno} GotoXY(X,Y+2); ClrEol; {Smazat ErrorMSG Okno} GotoXY(X,Y+3); ClrEol; {Smazat ErrorMSG Okno} End; Function FileNameDialog: Byte; Begin TextColor(7); TextBackground(0); GotoXY(53,3); Write('────────'); GotoXY(39,2); Write('jmeno souboru='); ReadLN(FileNameJmeno); FileName:=FileNameJmeno+FileNamePripona; FindFirst(FileName,Archive,DirInfo); If DosError>0 then Begin FileNameDialogOK:=False; Case DosError of 2: LoadError(1); {Nenalezen soubor} 3: LoadError(2); {Nenalezena cesta} 5: LoadError(3); {Přístup zamítnut} 6: LoadError(4); {Neplatný deskriptor} 8: LoadError(5); {Nedostatek paměti} 10: LoadError(6); {Neplatné prostředí} 11: LoadError(7); {Neplatný formát} 18: LoadError(8); {Soubor nenalezen} End; End else FileNameDialogOK:=True; {DosError=0 tzn. zadna chyba} GotoXY(53,3); ClrEol; GotoXY(39,2); ClrEol; End; Procedure FnLoad; Begin FileNameDialog; If FileNameDialogOK=True then Begin Assign(F,Filename); Reset(F,1); BlockRead(F,Grafika,8000); BlockRead(F,Barvy4,1000); BlockRead(F,Paleta,48); BlockRead(F,CisloStranky,1); Rozkodovat; Close(F); SoundDone; End else FileName:='none'; End; Procedure FnCreate; Var I: Byte; Begin FileNameDialog; Assign(F,Filename); ReWrite(F,1); BlockWrite(F,Grafika,8000); BlockWrite(F,Barvy4,1000); BlockWrite(F,Paleta,48); BlockWrite(F,CisloStranky,1); Close(F); {vytvoreni 16ti mono barev} For I:=0 to 15 do Begin Barva[I].R:=I*4; Barva[I].G:=I*4; Barva[I].B:=I*4; End; SoundDone; End; Procedure FnHelp; Var I: Byte; Ending: Boolean; Begin GotoXY(1,8); For I:=1 to 80 do Write('▄'); GotoXY(1,24); For I:=1 to 80 do Write('▀'); GotoXY(1,9); For I:=9 to 23 do Begin GotoXY(1,I); Write('█'); End; GotoXY(80,9); For I:=9 to 23 do Begin GotoXY(80,I); Write('█'); End; GotoXY(3,10); Write('Editor 8x8 - šipky=kurzor C=kopírovat V=vložit ze schránky ESC=EXIT'); GotoXY(3,11); Write(' F6=Editor40x40 F7=Nastavení barev F8=Míchání barev '); GotoXY(3,13); Write('Editor 40x40 - šipky=velký kurzor IJKL=malý kurzor ASDF=kreslení '); GotoXY(3,15); Write('Nastavení barev - šipky=velký kurzor IJKL=malý kurzor ASDF=Nastavení barev '); GotoXY(3,17); Write('Míchání barev - šipky doleva,doprava=výběr barvy '); GotoXY(3,18); Write(' Insert,Delete=přidat,ubrat červenou '); GotoXY(3,19); Write(' Home,End=přidat,unbrat zelenou '); GotoXY(3,20); Write(' PageUp,PageDown=přidat,ubrat modrou '); GotoXY(3,22); Write('Toto menu - šipky nahoru,dolů=výběr položky ENTER=potvrzení '); GotoXY(3,23); Write(' PgUp,PgDn=nastavení čísla stránky ,klav. zkratky=F1 F2 F3 F4 F5 '); Ending:=False; Repeat ReadKey; Delay(100); NoBeep; Case Port[$60] of {ESC} 1: Begin Ending:=True; End; End; {Case End} Until Ending=True; For I:=8 to 24 do Begin GotoXY(1,I); ClrEol; End; End; Procedure MMFunction; {enter in menu function} Begin Case MMSelect of 0: Begin SoundStorno; End; {NIC} 1: Begin If FileName='none' then FnCreate Else SoundStorno; End; {NEW} 2: Begin If FileName='none' then SoundStorno Else FnSave; End; {SAVE} 3: Begin If FileName='none' then FnLoad Else SoundStorno; End; {OPEN} 4: Begin If FileName='none' then SoundStorno Else FnEditor; End; {EDITOR} 5: Begin FnHelp; End; {HELP} End; End; Procedure WriteNabidka; Begin TextColor(14); TextBackground(1); GotoXY(1,2); Write('vytvořit F4'); GotoXY(1,3); Write('uložit F2'); GotoXY(1,4); Write('otevřít F3'); GotoXY(1,5); Write('editor F5'); GotoXY(1,6); Write('nápověda F1'); TextColor(7); TextBackground(0); GotoXY(80,25); End; Procedure WriteLista; Var I: Byte; Begin TextColor(14); TextBackground(1); GotoXY(1,1); For I:=1 to 79 do Write(' '); GotoXY(2,1); Write('╔MENU╗'); GotoXY(14,1); Write('EDITOR GRAFIKY'); GotoXY(34,1); Write('soubor=',FileName); GotoXY(58,1); Write('Stránka=',CisloStranky); GotoXY(73,1); Write('F10=EXIT'); TextColor(7); TextBackground(0); GotoXY(80,25); End; Procedure WriteMenu; Begin WriteLista; If MMSelect>0 then WriteNabidka; Case MMSelect of 0: Begin TextColor(7); TextBackground(0); GotoXY(1,2); ClrEol; GotoXY(1,3); ClrEol; GotoXY(1,4); ClrEol; GotoXY(1,5); ClrEol; GotoXY(1,6); ClrEol; GotoXY(80,25); End; 1: Begin TextColor(2); TextBackground(4); GotoXY(1,2); Write('vytvořit F4'); TextColor(7); TextBackground(0); End; 2: Begin TextColor(2); TextBackground(4); GotoXY(1,3); Write('uložit F2'); TextColor(7); TextBackground(0); End; 3: Begin TextColor(2); TextBackground(4); GotoXY(1,4); Write('otevřít F3'); TextColor(7); TextBackground(0); End; 4: Begin TextColor(2); TextBackground(4); GotoXY(1,5); Write('editor F5'); TextColor(7); TextBackground(0); End; 5: Begin TextColor(2); TextBackground(4); GotoXY(1,6); Write('nápověda F1'); TextColor(7); TextBackground(0); End; End;{Case End} End; Procedure MainMenu; Var Ending: Boolean; Begin ClrScr; MMSelect:=0; Ending:=False; Repeat WriteMenu; ReadKey; Delay(100); NoBeep; Case Port[$60] of {ESC} 1: Begin MMSelect:=0; End; {UP} 72: Begin If MMSelect>1 then Dec(MMSelect) Else MMSelect:=5; End; {DOWN} 80: Begin If MMSelect<5 then Inc(MMSelect) Else MMSelect:=1; End; {ENTER} 28: Begin MMFunction; End; {PgUp} 73: Begin If FileName='none' then SoundStorno Else If CisloStranky<7 then Inc(CisloStranky);End; {PgDn} 81: Begin If FileName='none' then SoundStorno Else If CisloStranky>0 then Dec(CisloStranky); End; {F1} 59: Begin FnHelp; End; {F2} 60: Begin If FileName='none' then SoundStorno Else FnSave; End; {F3} 61: Begin If FileName='none' then FnLoad Else SoundStorno; End; {F4} 62: Begin If FileName='none' then FnCreate Else SoundStorno; End; {F5} 63: Begin If FileName='none' then SoundStorno Else FnEditor; End; {F10} 68: Begin Ending:=True; End; End; {Case End} Until Ending=True; End; Procedure Main; Begin InitBuffers; FileName:='none'; CisloStranky:=0; MainMenu; ShutdownBuffers; ClrScr; End; {XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX} Begin Main; End.