From 2aa81e48f2fa74203b1fe529fc4006ccc0b9a1f0 Mon Sep 17 00:00:00 2001 From: Eugene Loza Date: Tue, 25 Aug 2015 02:34:01 +0200 Subject: [PATCH] Upload --- FOX1.PAS | 416 ++++++++++++++++++++++++++++++++++++++++++++++++++++ STLIB.PAS | 173 ++++++++++++++++++++++ SVGA256.BGI | Bin 0 -> 6335 bytes 3 files changed, 589 insertions(+) create mode 100644 FOX1.PAS create mode 100644 STLIB.PAS create mode 100644 SVGA256.BGI diff --git a/FOX1.PAS b/FOX1.PAS new file mode 100644 index 0000000..706de23 --- /dev/null +++ b/FOX1.PAS @@ -0,0 +1,416 @@ +{$R+}{$Q+} +program FoxHunt; +Uses Crt,Graph,StLib; +const MaxX=13; + MaxY=13; +const empty=9; +const MaxFox=8; +const Xs=36; + Ys=36; + +type FoxData=object + x,y:byte; + cond:boolean; +end; + +type scoreData=object + Names:string[10]; + mov :byte; +end; + +type HiScores=array[1..21] of scoreData; + +var map,r:array[1..MaxX,1..MaxY] of byte; + mx,my:byte; + str1,str2:string; + dx,dy:shortInt; + fox:array[1..MaxFox] of FoxData; + { caught,}saw:byte; + + timer,tt:byte; + + lastHi:byte; + last:byte; + ch:array[1..10] of char; + LastN:byte; + show:boolean; + victory:byte; + tempS:ScoreData; + Hi:HiScores; + File1:file of HiScores; + + x1,x2,y1,y2:integer; + + mx1,my1:integer; + mx2,my2:integer; + mb1,mb2:integer; + mmouse:boolean; + Marray:array[1..1000] of byte; + +{0-5+ NUMBERs} +{.- empty} +{10-1.-marked empty} + +procedure showScores; +begin + show:=false; + setFillStyle(1,10); + bar(480,50,635,300); + setColor(63); + rectangle(479,49,636,301); + for i:=1 to 20 do with hi[i] do begin + str(mov:2,str1); + str(i :2,str2); + if mov>99 then str1:='±±'; + setColor(183); + if (mov=timer) or ((i=1) and (mov>timer)) then line(481,74+i*10,634,74+i*10); + if (movtimer) then line(481,78+i*10,634,78+i*10); + + if i<>lastHI then setColor(63) else setColor(123); + outTextXY(485,70+i*10,str2+')'+names); + outTextXY(618,70+i*10,str1); + line(614,50,614,300); + end; +end; + +procedure sortScores; +begin +for j:=1 to 21 do begin + for i:=1 to 20 do begin + if hi[i].mov>hi[i+1].mov then begin + TempS:=hi[i]; + hi[i]:=hi[i+1]; + hi[i+1]:=TempS; + if i+1=lastHi then dec(lastHi); + end + end; +end; +{showScores;} +rewrite(file1); + write(file1,hi); + close(file1); +end; + +procedure eraseScores; +begin +for i:=1 to 21 do with hi[i] do begin + str(22-i,str1); + names:='manúú'+str1; + mov:=99-i*2; +end; +sortScores; +rewrite(file1); + write(file1,hi); + close(file1); +end; + +procedure NewGame; +begin +reset(file1); + read(file1,hi); +close(file1); +last:=1; +show:=true; +setFillStyle(1,0); +bar(0,0,640,480); +victory:=0; +timer:=0; +mx:=(maxX+1) div 2; +my:=(maxY+1) div 2; +hi[21].mov:=82; +for i:=1 to maxY do + for j:=1 to MaxX do begin + r[j,i]:=1; + map[j,i]:=empty; + end; +for i:=1 to MaxFox do with fox[i] do begin + x:=round(random*(maxX-1)+1); + y:=round(random*(MaxY-1)+1); + cond:=false; +end; +if mmouse=true then mouseLocate((mx-1)*Xs+3*xs div 4,(my-1)*Ys+3*ys div 4); +mousePoll(mx1,my1,mb1,mb2); +mx2:=mx1; +my2:=my1; +{getimage(mx1,my1,mx1+10,my1+10,MArray);} +end; + +procedure ShowMap; +begin +for i:=1 to maxY do + for j:=1 to MaxX do if r[j,i]>0 then begin + r[j,i]:=0; + case map[j,i] of + 0 :l:=25; + 1..MaxFox :l:=75+((map[j,i])*2); + empty :l:=5; + 10 :l:=7; + 11..(10+MaxFox):l:=150+((map[j,i]-10)*2); + empty+10:l:=167; + 20 :l:=17; + 21..(20+MaxFox):l:=140+((map[j,i]-20)*2); + + end; + dx:=0; + for k:=1 to MaxFox do if (fox[k].x=j) and (fox[k].y=i) and (fox[k].cond=true) then inc(dx); + if dx>0 then l:=115; + + x1:=(j-1)*Xs+5; + y1:=(i-1)*Ys+5; + x2:=(j)*Xs+1; + y2:=(i)*Ys+1; + + setColor(23); + recTangle(x1-1,y1-1,x2+1,y2+1); + setColor(63); + setFillStyle(1,l); + bar(x1,y1,x2,y2); + if (map[j,i]<>empty) and (map[j,i]<>10+empty) and (dx=0) then begin + if map[j,i]=20 then str(map[j,i]-20,str1); + outTextXY((x1+x2) div 2-4, + (y1+y2) div 2-4,str1); + end; + if map[j,i]>=20 then begin + ellipse((x1+x2) div 2, + (y1+y2) div 2,0,360,xs div 2-4,ys div 3); + end; + setColor(252); + if dx>0 then for k:=1 to dx do begin + outTextXY((x1+x2) div 2-4-(dx+1)*4+k*8, + (y1+y2) div 2-4,'o'); + outTextXY((x1+x2) div 2-4-(dx+1)*4+k*8, + (y1+y2) div 2-4,'Y'); + end; + end +end; + +procedure adv(ax,ay:shortInt); +begin +if (ax>0) and (ay>0) and (ax<=MaxX) and (ay<=MaxY) then begin + if map[ax,ay]<10 then inc(map[ax,ay],10); + r[ax,ay]:=1; +end; +end; + +BEGIN +randomize; +MouseInit; +SetGraficMode(2); +{ 1- 63 white} +{ 64-126 green} +{127-189 blue } +{190-252 red } +for i:=1 to 63 do SetRGBPalette(i ,i,i,i); +for i:=1 to 63 do SetRGBPalette(i +63,0,i,0); +for i:=1 to 63 do SetRGBPalette(i+126,0,0,i); +for i:=1 to 63 do SetRGBPalette(i+189,i,0,0); +SetRGBPalette(253,63,0,60); +assign(file1,'Scores.fox'); + +{$I-} +reset(file1); +{$I+} +if ioresult<>0 then eraseScores else close(file1); + +LastN:=0; +lastHi:=0; +MMouse:=true; +NewGame; +repeat +showMap; + setfillStyle(1,0); + bar(500,450,640,470); + + j:=0; + for i:=1 to 20 do begin + if hi[i].mov=timer then j:=i*2; + if (hi[i].movtimer) then j:=i*2+1; + end; + if j<>last then begin + last:=j; + show:=true; + end; + + if show=true then showScores; + + + setColor(63); + str(timer,str1); + outTextXY(500,461,'MOVES:'+str1); + str1:=''; + for i:=1 to MaxFox do if fox[i].cond=false then str1:=str1+'*'; + outTextXY(500,451,'FOXES:'); + setColor(252); + outTextXY(548,451,str1); + if str1='' then begin + setColor(63); + if victory<2 then begin + setTextStyle(0,0,9); + outTextXY(0,200,'VICTORY!'); + setTextStyle(0,0,0); + end; + if Victory=0 then begin + victory:=1; + if timer0 then + for j:=1 to i do outTextXY(520+j*8,375,ch[j]); + + outTextXY(528+i*8,375,'@'); + key:=readKey; + case key of + 'a'..'z','A'..'Z','1'..'9','0',' ','(',')': + if i<10 then begin + inc(i); + ch[i]:=key; + end; + '-','+','*','/':if i>0 then dec(i); + end; + until (key=enter); + lastN:=i; + str1:=''; + for j:=1 to i do str1:=str1+ch[j]; + if str1='' then str1:='Incognito'; + with hi[21] do begin + names:=str1; + mov:=timer; + end; + lastHi:=21; + SortScores; + ShowScores; + end; + end; + end; + + j:=62; + k:=-1; + getimage(mx1,my1,mx1+10,my1+10,MArray); + repeat + key:='|'; + + inc(j,k); + if j=32 then k:=1; + if j=63 then k:=-1; + setColor(j{+189}); + x1:=(mx-1)*Xs+5; + y1:=(my-1)*Ys+5; + x2:=(mx)*Xs+1; + y2:=(my)*Ys+1; + recTangle(x1-2,y1-2,x2+2,y2+2); + + if keyPressed then key:=readKey; + + if Mmouse=true then begin + mousePoll(mx1,my1,mb1,mb2); + my1:=round(my1/200*480); + if mx1>MaxX*xs then mx1:=MaxX*xs; + if my1>MaxY*ys then my1:=MaxY*ys; + mouseLocate(mx1,round(my1/480*200)); + + if (mx2<>mx1) or (my2<>my1) then begin + Putimage(mx2,my2,MArray,normalPut); + getimage(mx1,my1,mx1+10,my1+10,MArray); + end; + mx2:=mx1; + my2:=my1; + + setColor(253); + line(mx1 ,my1 ,mx1+10,my1+10); + line(mx1+ 1,my1 ,mx1+10,my1+ 9); + line(mx1 ,my1+ 1,mx1+ 9,my1+10); + line(mx1 ,my1 ,mx1+ 5,my1 ); + line(mx1 ,my1 ,mx1 ,my1+ 5); + line(mx1 ,my1 ,mx1+ 6,my1+ 1); + line(mx1 ,my1 ,mx1+ 1,my1+ 6); + if mb1=1 then key:=enter; + if mb2=2 then key:=f1; + if (mb1=1) or (mb2=2) then begin + r[mx,my]:=1; + mx:=round((mx1+xs/2)/xs); + my:=round((my1+ys/2)/ys); + if mx>MaxX then mx:=MaxX; + if my>MaxY then my:=MaxY; + if mx<1 then mx:=1; + if my<1 then my:=1; + end; + end; + until key<>'|'; + setColor(0); + recTangle(x1-2,y1-2,x2+2,y2+2); + Putimage(mx2,my2,MArray,normalPut); + + + r[mx,my]:=1; + case Key of + up:if my>1 then dec(my); + down:if my1 then dec(mx); + right:if mxempty) and (map[mx,my]<>10+empty) then begin + if map[mx,my]>=20 then dec(map[mx,my],10); + dx:=-MaxX; + dy:=-MaxY; + repeat + adv(mx+dx,my ); + adv(mx ,my+dy); + adv(mx+dx,my+dy); + adv(mx-dx,my+dy); + inc(dx); + inc(dy) + until (dx>=MaxX+1) and (dy>=MaxY+1);; + inc(map[mx,my],10); + end; + f2:begin + if (map[mx,my]>10) and (map[mx,my]<20) then dec(map[mx,my],10); + if (map[mx,my]>=20) then dec(map[mx,my],20); + end; + f3:if (map[mx,my]<10) then inc(map[mx,my],10); + f5:for i:=1 to maxY do + for j:=1 to maxX do + if (map[j,i]>9) and (map[j,i]<20) then begin + dec(map[j,i],10); + r[j,i]:=1 + end; + '{':begin + for i:=1 to MaxFox do begin + fox[i].cond:=true; + r[fox[i].x,fox[i].y]:=1; + end; + victory:=2; + end; + enter:if map[mx,my]=empty then begin + if timer<255 then inc(timer,1); + saw:=0; + for i:=1 to MaxFox do with fox[i] do begin + dx:=abs(x-mx); + dy:=abs(y-my); + if (dx=dy) and (dx=0) then cond:=true; +{ if (dx=dy) then inc(saw);} + if ((dx=0) or (dy=0)) or (dx=dy) then inc(saw); + end; +{ if saw=6 then halt;} + map[mx,my]:=saw; + end; + 'q':NewGame; + end; + r[mx,my]:=1; +until key=f10; +restoreCRTMode; +CloseGraph; +END. \ No newline at end of file diff --git a/STLIB.PAS b/STLIB.PAS new file mode 100644 index 0000000..9d21ca4 --- /dev/null +++ b/STLIB.PAS @@ -0,0 +1,173 @@ +{$Q-}{$R-}{$S-}{$N+} +unit StLib; + +InterFace +Uses Crt,dos,graph; +const F1 =#59; +const F2 =#60; +const F3 =#61; +const F4 =#62; +const F5 =#63; +const F6 =#64; +const F7 =#65; +const F8 =#66; +const F9 =#67; +const f10 =#68; +const f11 =#133; +const f12 =#134; + +const Esc =#27; +const enter=#13; + +const UpL =#71; +const Up =#72; +const UpR =#73; +const Left =#75; +const Right=#77; +const DownL=#79; +const Down =#80; +const DownR=#81; + +const Ins =#82; +const del =#83; + +var reg:registers; + +{Function sgn(base:integer):shortint;} +Function Rnd:real; +{procedure maketables;far;} +Procedure Rkey; +Procedure SetGraficMode(gm:byte);far; +Procedure SetTextMode;far; +Procedure Curs(Visible:boolean);far; +Procedure MouseCover;far; +Procedure MouseInit;far; +Procedure MouseLocate(Row,Column:integer); +Procedure MousePoll(var Row,Column,LeftButton,RightButton:integer); +Procedure MouseShow;far; + +Var J,I,K,L : integer; + key,key1: char; + Flg : Boolean; + RandomBase:real; + +{ sint,cost: array [0..359] of double;} + +implementation + +{function sgn(base:integer):shortint; +begin + if base < 0 then Sgn:=-1; + if base > 0 then Sgn:=+1; + if base = 0 then Sgn:=0 +end;} +{---------------------------------} +Procedure Rkey; +begin + key:=readKey; + if key=#0 then key1:=readKey; +end; +{---------------------------------} +procedure Curs(Visible:boolean); +Const SizeCursor:word=0; +begin + with Reg do begin + if Visible=True then CX:=SizeCursor; + if Visible=False then begin + BH:=0; + AH:=03; + INTR($10,reg); + SizeCursor:=Cx; + CH:=$20 + end; + AH:=01; + Intr($10,Reg) + end +end; {Cursor} +{------------------------------------------} +{--------} + +procedure SetTextMode; +begin +TextMode(co80+font8x8); +mouseInit; +ClrScr; +randomize; +curs(false) +end; +{----------------------} +Procedure SetGraficMode(gm:byte); +var GraphDriver : integer; + GraphMode : integer; + ErrorCode : integer; +begin + MouseInit; + + Graphdriver :=installUserDriver('svga256',nil); + Graphdriver :=16; + GraphMode:=gm; + InitGraph(GraphDriver,GraphMode,'c:\tp7\bgi\'); + ErrorCode := GraphResult; + if ErrorCode <> grOk then + begin + Writeln ('Graph error: ', GraphErrorMsg(ErrorCode)); + Writeln ('Program halted'); + Halt(1) + end; +end; +{-------------------------} +function Rnd:real; +begin + randomBase:=frac(sqr(sqr(sqr(randomBase+pi)))); + rnd:=RandomBase +end; +{-------------------------} +{Procedure MakeTables; +Begin + for i:=0 to 359 do + begin + sint[i]:=sin(abs(i)*pi/180.0); + cost[i]:=cos(abs(i)*pi/180.0) + end; +end;} +Procedure MouseCover; +begin + Reg.AX:=2; + intr($33,Reg) +end; +{------------------------------------------} +Procedure MouseInit; +begin + Reg.AX:=0; + intr($33,Reg); + if Reg.AX=0 then begin + halt; + end +end; +{--------------------------------------------} +Procedure MouseLocate(Row,Column:integer); +begin + Reg.AX:=4; + Reg.CX:=Row; + Reg.DX:=Column; + intr($33,Reg) +end; +{--------------------------------------------------} +Procedure MousePoll(var Row,Column,LeftButton,RightButton:integer); +begin + Reg.AX:=3; + intr($33,Reg); + Row:=Reg.CX; + Column:=reg.DX; + LeftButton:=(reg.BX and 1); + RightButton:=(Reg.BX and 2); +end; +{------------------------------------------} +Procedure MouseShow; +begin + Reg.AX:=1; + intr($33,Reg) +end; + +BEGIN +END. \ No newline at end of file diff --git a/SVGA256.BGI b/SVGA256.BGI new file mode 100644 index 0000000000000000000000000000000000000000..c53e3caccc72d43914f454e4b5147156d359077e GIT binary patch literal 6335 zcmeHLeOOahnm;EuoEs7d;ltpLZHP)!9jZl8l!6qsjn=M$Fr|tW>!@RSW=7bMi}qQ- zFzi!Ej#YQsr|Pz|E2izv*Um)8sfbPmE(J!U@-bCf-9ibqp+SPbB@hbsg4|pg8U!fumwqp-gS>Yh+F}llcv2(oTOkhgPb)T=aTq@rTdpBtq7zfDFFyH1C7Xe zI(wCINdowlu`Kl>^b2$w&B0GYsS0r=I)#Gp<9G|cj{XJ9n>w?FFjJwxc0a)VZt-0O zzN^4@75INy0STVVm-kPMjXfB?Bq78IE0ijoG2PZ%U%_i1T2VN>Kh+RcDSq}&Xa1So zMQ=PSRaI3nDqkHtdv@&V^2>?-j|~n>MpbB@O!8#~F7(VzI?x0g*>S1>f~Qx0%df}z znfZgW7h$;r=!ZZ%fu^4OdAp{VFzyF>8R(yZ%7CVxLKKAxQ9RHRnN^4)<&j}t0LqhB z2yG3FY{&-s!F_8sWw`A?Oy~ZGt+xS9*_o2v&u2N@|15?@e1NeiFg_0B6n_QGr}#ky zKSDtTdw}u-NdKV7fDOyQKpaqzd|N3p_`vuepJ{}uHx%sJZQNU6H5Lhlg#{Mt?p?-$ zy+-Rx`9;Q^J1n~vhpJ<1KjdmSlmhMRn9tilXU0%*m(hyY>x_U<%_r`enfPD zs`}4DP)#Hn6PekK9XC5}a!HGLs-!O{%F`C{dsJ4nrcO|5u3MLliA_YsV*_7^X}L154(=On+mQv;Dr=uU+la7$ME|~X>euC4Ekd#ZMN;+D3$)5Cc($Qzv zzd_|HZPauDbKSO1#2FUyk@`4(Rb@{Wl%6KNOB`=+4tH_BT$*&8JfX+D zmGi7tb$nPvP8=hqSAsOxOCveM8>IT@gnoIP8;ks?@8f}WlbqpoQhkJYy@bVcj%X24~E`5@iuYv+R~sZf-#zPbU&)$bz|e0kNGp6AeHgQtq$;`v8p z&fvf+q`Tqe_j!>T8gRf!J};|69C5ezDQT-W*rP|QJy|^c&=ZPgwAy*GW1tBC`p$2} zEXP%tY7*<(n;$~+8h-88`KRs8wi{@E!*BYAbH(<43x-z_78Cj%cN_zbOSHR2r)$%R zCy$XT)7wNm=_IL=HT*Hf{yE1^ab3N1xV-5U@ha&Z5_9oa(C+7y=*~N0sa|S9k`@t ziu(~h&_y=Uq&9pAzADTwH+)Wos?TCu+9iyv_%)Lw%AA?A$-mTqto_UOt9|2+tF)!P zuSm^lTd=xQ_?uT@U6@iYsMwm;d;7DpH!&YAc>ObeRqnOQOP)JlZP}XZy}l)HGY8T3 zIk)iB-HxG|PQDFwXK*ZNX#KiTQxnGI95($np+CnHC*@Jd#4jcbq4m8=tUrtUdgbp0 zt!HrBO|?x}e2xx2pF@k4w2XMQw2Ah3{*8M=e+^stjmb$@aM_@lHsx*K_6;~o0B254 z>cXXi8^4aj=9JL`5nwb=<$21FzD1k7T#Y3CoyqEh#OWZ<=Xj1v6^%;gK|(*I*C3W# z6MqNvexDkuNQav?Rg|ewsbaLCMIOV#pTNIY5m$G=={PC5Oa^Bhxm)tZ zGc_1_|6y&)m9hwiNj}?+h15%w0Ke~h7*3S%p6OZEKP;Y9hG^Z)4T}A8PDBtkR+=Y(L(SuMGngA=bs3|@6LMU?n2MroW7!(5dkSal@b~BWX z1q4|FO6l=}oIu*#z_XJBJ0_dqP?n@B?KKQ1$vsaAV%sAqyhYGk^%HWZIiX9^;+4(N zei#9}ld++Ry-%`cg?n)Avvz;iLa)$^@k;0*%?MmKS4X>@hgjR+VH(wk$Y^&atnvd9 z)JsXS^bh{E^_2Ma^FDAG-+)u;3{LDcIikg^Z$-U_a~aH36)kG{^E;7fqI|kDaJ`Jl zw@ZV3z16epjrgxOI%cB#6cwV9T@C?vKgIG@WpXUzO;yV)L@b0HtP4WALv<_Bk$n*r z&FsSH>kQl+8((e|(QKVcrjx%U3H@}K-IVOsWVfY>E;rkg0%1)4AHukaOb%X-#Fq9; zq7sO@PSAKm*g{#N7-@$qm;bilE=&jayMYfzoLAs)g$``jc452zBP@a;l6d``gjk{8 z!(xpJwQhp{4LJOqoI6cWf=sm)t#m;w0YbI?tiTQC!ui)=( z7BjOpIas`xW5<9G}AKH@3AhEoox4oZz)QutOwQbxGu-o0P z`3&}z&8<+2LjZI1)?S1?7&_hUIx%GH4|6oO_xeBT#?x&~$Cb!5CTwobufg_=3{5r+ zPF@O8I(l8ice>G~@iQDI%-jB^sBPq2S|8}13hHvZ3{1br<~B0@Y{n`VZOG5wZgZai zHYn7DyL?+aye=(6Pukqr?`_i~VaVZOa`L6m@wu%ZyYBiNAH;@0c7yGM>R#6fD6EIX zVFrLx%FcdUzwz|t!P5<~J?cie8f>%Jr@|fY8Ub6(#bKMfa5|xyupl3c-CwZwepfJy z-ml~eg^ZcT7dH3ofQH9hV?e%I4%gUVfRz?a>$`NdSD~jji!eYFxP5<6x|B@+p3SXf z`dQhTnKdK`tok;eLFa?fs9TxN3JH<fz@+TI`g86AH;^i7EJd_ZI9ewnb}z*CKXTHvl6dMhG0H-jr`sU)d=)!Jad~` zZV6BQ*}l+b!v3spCJNpeA=aP_`3J(v3?zK7d}YqlLR5LFB72n}!}iFqv{?YFJ5*;X zPfJIMON1y>wGKH6&kSvcw}P*T0z_fr^@%oJYN4=z2@cDG|A?yS8!jKW?Xi;b@fYU{ zAxz|xMKO^9tJJU@naU3+j{itlV6r{APngF*|H+$d2XLZQ9-b3qm8J-hdHZ3M2)pKQ z|JblpvhUGUg=PNzmYa!^-w>I~S!91aWTE7@Gk*ngjOF*1=LnHZAwy2^RhTRJzeI{q zZ&xs@6`Vx#Sbx^GMW4gSa}8N!_%%6V4TpU-Q4qFI15?+lt|q@vBft)ioMFw@aE TG&ryEiAF&M-xZjFWJvs9ydB-| literal 0 HcmV?d00001