of FREE Atari source listings !!
CROSSWORDS (colour)
|
|
LOVEPOPA's UNIVERSE of FREE Atari source listings !! CROSSWORDS (colour) |
|
'
' CROSSWORDS - color version
' (C) 9/26/1986, by PKF - v4
'
@Pro_tect
If Xbios(4)<>1
Alert 3,"Medium resolution only!",1," Ok ",Z%
End
Endif
For Z%=1 To 3
A$="crcvrb_"+Str$(Z%)+".dat"
If Exist(A$)=0
Alert 3,"Fatal error!|Crossword sources missing!",1,"Abort",I%
End
Endif
Next Z%
Clear
@Init
If Exist("crcvrb_4.rsc")=-1
Open "i",#1,"crcvrb_4.rsc"
Input #1,K%
Close #1
Kill "crcvrb_4.rsc"
Else
K%=1
Endif
@Grow_box(0,0,40,40/2,130,165/2,375,68/2,0)
Deffill 1,5,5
Pbox 130,165/2,505,233/2
Deffill 2,1,1
Box 132,167/2,503,231/2
Box 133,168/2,502,230/2
Deftext ,,,13
Text 165,200/2," C R O S S W O R D S"
Deftext ,,,6
Text 145,220/2,"(C) 9/26/1986, by PKF - v4.0"
Repeat
Until Mousek Or Inkey$<>""
Deffill 7,2,4
Pbox -1,-1,640,400
@Grow_box(130,165/2,375,68/2,100,100/2,440,240/2,0)
Deffill 1,5,5
Pbox 95,95/2-1,545,345/2-1
Deffill 2,1,1
Box 99,99/2-1,541,341/2-1
Box 98,98/2-1,542,342/2-1
For X%=100 To 340 Step 20
Line 100,X%/2-1,540,X%/2-1
Next X%
For Y%=100 To 540 Step 20
Line Y%,100/2-1,Y%,340/2-1
Next Y%
Deffill 1,5,5
For Z%=0 To 2
Pbox 1,(2+Z%*20)/2,61,(19+Z%*20)/2
Next Z%
Pbox 1,62/2,61,99/2
For Z%=5 To 7
Pbox 1,(2+Z%*20)/2,61,(19+Z%*20)/2
Next Z%
Deffill 2,1,1
Deftext ,,,4
Text 15,14/2," Info"
Text 15,34/2," File"
Text 15,54/2," Help"
Text 15,84/2," Quit"
Text 15,114/2," Load"
Text 15,134/2," Save"
Text 15,154/2," Make"
Get 95,95/2,545,345/2,Y$
@Dat_inp(K%)
@Grow_box(100,100/2,440,240/2,100,0/2,440,55/2,0)
Deffill 1,5,5
Pbox 100,0/2,540,55/2
Deffill 1,1,1
Box 102,2/2,538,53/2
Box 103,3/2,537,52/2
Deftext ,,,4
Text 251,12/2,"Crosswords v4.00"
Deftext ,,,13
@Pul_msg
Do
M%=0
If Mousek
M%=Mousek
X%=Trunc(Mousex-80)/20
Y%=Trunc(Mousey-80/2)/(20/2)
If X%>0 And Y%>0 And X%<23 And Y%<13
W%=0
For Z%=0 To Nbuchi%
If X%=N%(Z%,0) And Y%=N%(Z%,1)
W%=1
Endif
Next Z%
If W%=0
If M%=1
I%=-1
For Z%=0 To Norizz%
If X%=Val(C$(Z%,0)) And Y%=Val(C$(Z%,1))
I%=Z%
Endif
Next Z%
If I%>=0
Deftext ,,,6
A$="ACROSS: "
Print At(15,2);A$;C$(I%,2)
Print At(15,3);"[";C$(I%,4);"] ";
Form Input Val(C$(I%,4)),A$
A$=Upper$(A$)
If A$=C$(I%,3)
For Z%=1 To Val(C$(I%,4))
Text 20*(Z%+Val(C$(I%,0)))+70,(20*Val(C$(I%,1))+95)/2,Mid$(C$(I%,3),Z%,1)
Next Z%
For Z%=1 To Val(C$(I%,4))
Sc$(Z%+Val(C$(I%,0))-1,Val(C$(I%,1)),1)=Mid$(C$(I%,3),Z%,1)
Next Z%
@Pul_msg
Else
Print At(15,3);"wrong answer.";Space$(15)
Pause 50
@Pul_msg
Endif
Else
@Alt_put
Endif
Endif
If M%=2
For Z%=Norizz%+1 To Ntot%
If X%=Val(C$(Z%,0)) And Y%=Val(C$(Z%,1))
I%=Z%
Endif
Next Z%
If I%>=Norizz%+1
Deftext ,,,6
A$="VERTICAL: "
Print At(15,2);A$;C$(I%,2)
Print At(15,3);"[";C$(I%,4);"] ";
Form Input Val(C$(I%,4)),A$
A$=Upper$(A$)
If A$=C$(I%,3)
For Z%=1 To Val(C$(I%,4))
Text 20*Val(C$(I%,0))+90,(20*(Z%+Val(C$(I%,1)))+75)/2,Mid$(C$(I%,3),Z%,1)
Next Z%
For Z%=1 To Val(C$(I%,4))
Sc$(Val(C$(I%,0)),Z%+Val(C$(I%,1))-1,1)=Mid$(C$(I%,3),Z%,1)
Next Z%
@Pul_msg
Else
Print At(15,3);"Wrong answer.";Space$(15)
Pause 50
@Pul_msg
Endif
Else
@Alt_put
Endif
Endif
Endif
Endif
If X%<0 And Y%=-2
Put 95,95/2,Y$
Clear
@Init
Get 95,95/2,545,345/2,Y$
@Schema
@Dat_inp(K%)
Endif
If X%<0 And Y%=3
Alert 1,"This feature allows you to create|your own scheme: follow the|instructions carefully and|try to avoid errors!!",2,"Ok|Cancel",Zz%
If Zz%=1
@Pulisci
Z%=0
B$=""
If Dfree(0)>8192
@Pulisci
Put 95,95/2,Y$
Deftext ,,,4
Text 115,12/2,Space$(17)+"Crosswords v4.00"+Space$(17)
Deftext ,,,13
Fileselect "\*.DAT","CRCVRB_4.DAT",B$
If Len(B$)>1
Open "o",#1,B$
Print #1,"��"
Repeat
Print At(15,2);"Please input the number of black cells: ";
Form Input 2,Nbuchi$
Nbuchi%=Trunc(Val(Nbuchi$))-1
Until Nbuchi%>0
Print #1,Nbuchi%
Repeat
@Pulisci
Print At(15,2);"Please input the number of ACROSS definitions: ";
Form Input 2,Norizz$
Norizz%=Trunc(Val(Norizz$))-1
Until Norizz%>0
Print #1,Norizz%
Repeat
@Pulisci
Print At(15,2);"Please input the TOTAL number of definitions: ";
Form Input 2,Ntot$
Ntot%=Trunc(Val(Ntot$))-1
Until Ntot%>Norizz%+1
Print #1,Ntot%
Print At(15,2);"Press mouse buttons onto cells to turn "
Print At(15,3);"them black and press any key to confirm."
For Z%=0 To Nbuchi%
Repeat
Until Mousek
X%=Trunc(Mousex-80)/20
Y%=Trunc(Mousey-80/2)/(20/2)
@Pulisci
Print At(15,2);"Number of current cell: ";Z%+1
Print At(15,3);"Coordinates are: X=";X%;", Y=";Y%;" save them (Y/n)?";
Zz%=Inp(2)
If Zz%<>110 And Zz%<>78 And X%>0 And X%<23 And Y%>0 And Y%<13
Pbox X%*20+83,Y%*20+83/2,X%*20+97,Y%*20+97/2
Print #1,X%
Print #1,Y%
Else
Dec Z%
Endif
Next Z%
@Pulisci
Print At(15,2);"Press mouse buttons onto cells to set the"
Print At(15,3);"starting point of ACROSS definitions."
Deffill 6,2,5
For Z%=0 To Norizz%
@Oriz_vert
Next Z%
@Pulisci
Print At(15,2);"Press mouse buttons onto cells to set the"
Print At(15,3);"starting point of VERTICAL definitions."
Deffill 7,2,3
For Z%=Norizz%+1 To Ntot%
@Oriz_vert
Next Z%
Close #1
Alert 3,"Well done!|Select Quit to exit, or|Continue to go on.",1,"Continue|Quit",Zz%
If Zz%=2
End
Endif
Endif
Put 95,95/2,Y$
Clear
@Init
Deffill ,1,1
Get 95,95/2,545,345/2,Y$
@Schema
@Dat_inp(K%)
Else
Pause 50
@Pulisci
Endif
Endif
Endif
If X%<0 And Y%=2
Fileselect "\*.CVB","SCHEMA1.CVB",B$
If Len(B$)>1
Open "o",#3,B$
Print #3,"�"
Print #3,K%
For Z%=1 To 12
For Zz%=1 To 22
Print #3,Zz%;",";Z%;",";Sc$(Zz%,Z%,1)
Next Zz%
Next Z%
Close #3
Alert 1,"Data have been properly saved!",1," Ok ",Z%
Endif
Endif
If X%<0 And Y%=1
Put 95,95/2,Y$
Clear
@Init
Get 95,95/2,545,345/2,Y$
Fileselect "\*.CVB","SCHEMA1.CVB",B$
If Len(B$)>1 And Exist(B$)=-1
Open "i",#4,B$
Input #4,A$
If A$="�"
Input #4,K%
@Dat_inp(K%)
Deftext ,,,6
For Z%=1 To 12
For Zz%=1 To 22
Input #4,Zz%
Input #4,Z%
Input #4,A$
Sc$(Zz%,Z%,1)=A$
If Asc(A$)>64 And Asc(A$)<91
Text 20*Zz%+90,(20*Z%+95)/2,A$
Endif
Next Zz%
Next Z%
Close #4
@Pul_msg
Alert 1,"Data have been properly loaded!",1," Ok ",Z%
Else
Close #4
Alert 1,"Error!|.CVB file corrupted!",1,"Cancel",Z%
Endif
Else
@Init
Get 95,95/2,545,345/2,Y$
@Schema
@Dat_inp(K%)
Endif
Endif
If X%<0 And Y%=-3
Alert 0,"Developed|by PKF|",1," Ok ",Z%
Endif
If X%<0 And Y%=-1
If Exist("crcvrb_4.pkf")=-1
Get 0,0,639,399/2,D$
Cls
Open "i",#1,"crcvrb_4.pkf"
A%=0
Do
Exit If Eof(#1)
Line Input #1,A$
Print A$
Inc A%
If A% Mod 24=23
Print Tab(40);"-- Press any key to continue --"
Void Inp(2)
Endif
Loop
Close #1
Print
Print
Print
Print Tab(16);"-- End of file: any key to exit --"
Void Inp(2)
Put 0,0,D$
Else
Alert 1,"File not found!",1," Ok ",Z%
Endif
Endif
Endif
Exit If X%<0 And Y%=0
Loop
@Grow_box(100,100/2,440,240/2,100,0,440,55/2,1)
Deffill 7,2,4
@No_box(0)
Pbox 100,0,540,55/2
@Grow_box(130,165/2,375,68/2,100,100/2,440,240/2,1)
Deffill 7,2,4
@Grow_box(0,0,40,40/2,130,165/2,375,68/2,1)
Pbox -1,-1,640,400/2
@No_box(1)
End
Procedure Grow_box(Xa,Ya,B1,H1,Xn,Yn,B2,H2,Expand%)
Dpoke Gintin,Xa
Dpoke Gintin+2,Ya
Dpoke Gintin+4,B1
Dpoke Gintin+6,H1
Dpoke Gintin+8,Xn
Dpoke Gintin+10,Yn
Dpoke Gintin+12,B2
Dpoke Gintin+14,H2
Gemsys 73+Expand%
Return
Procedure Pul_msg
Pt%=0
For Zz%=1 To 12
For Z%=1 To 22
If Sc$(Z%,Zz%,1)="_"
Inc Pt%
Endif
Next Z%
Next Zz%
If Pt%>0
For I%=2 To 3
Print At(15,I%);Space$(53)
Next I%
Deftext ,,,4
Text 135,12/2,"h "+Left$(Time$,5)
Text 430,12/2,"Points = "+Str$(Pts%-Pt%)
Deftext ,,,13
Else
Alert 3,"WELL DONE!|What about now?",1,"Another|Print|Quit",Zz%
If Zz%=3
End
Endif
If Zz%=2
Hidem
Hardcopy
Lprint
Showm
Endif
Alert 3,"Please insert original disk|into drive A: and|remove write protection.",1," Ok ",Z%
@Schema
Open "o",#1,"crcvrb_4.rsc"
Print #1,K%
Close #1
Run
Endif
Return
Procedure Alt_put
Print At(15,2);"Input the letter you want to write in:"
Do
W%=Inp(2)
Exit If (W%>64 And W%<91) Or (W%>96 And W%<123) Or W%=32
Print At(13,2);" "
Loop
A$=Chr$(W%)
A$=Upper$(A$)
Print At(60,2);A$
Deftext ,,,6
Text X%*20+90,(Y%*20+95)/2,A$
Pause 20
If A$=Sc$(X%,Y%,0)
Sc$(X%,Y%,1)=A$
Endif
@Pul_msg
Return
Procedure Dat_inp(K%)
Put 95,95/2,Y$
K$="crcvrb_"+Str$(K%)+".dat"
Open "i",#1,K$
Seek #1,0
Input #1,A$
If A$<>"��"
Alert 1,"Fatal error!|.DAT file corrupted!",1,"Abort",I%
End
Endif
Input #1,Nbuchi%
Input #1,Norizz%
Input #1,Ntot%
Erase N%()
Erase Sc$()
Dim N%(Nbuchi%,1)
Dim Sc$(22,12,1)
For Zz%=0 To 1
For Z%=0 To 22
For I%=0 To 12
Sc$(Z%,I%,Zz%)="_"
Next I%
Next Z%
Next Zz%
For Z%=0 To Nbuchi%
Input #1,X%
Input #1,Y%
N%(Z%,0)=X%
N%(Z%,1)=Y%
Pbox (X%*20+83),(Y%*20+83)/2,(X%*20+97),(Y%*20+97)/2-1
Sc$(X%,Y%,0)="*"
Sc$(X%,Y%,1)="*"
Next Z%
Erase C$()
Dim C$(Ntot%,4)
For Z%=0 To Ntot%
For I%=0 To 4
Input #1,A$
C$(Z%,I%)=A$
Next I%
Next Z%
Close #1
For I%=0 To Norizz%
For Z%=1 To Val(C$(I%,4))
Sc$(Z%+Val(C$(I%,0))-1,Val(C$(I%,1)),0)=Mid$(C$(I%,3),Z%,1)
Next Z%
Next I%
For I%=Norizz%+1 To Ntot%
For Z%=1 To Val(C$(I%,4))
Sc$(Val(C$(I%,0)),Z%+Val(C$(I%,1))-1,0)=Mid$(C$(I%,3),Z%,1)
Next Z%
Next I%
Pts%=0
For Zz%=1 To 12
For Z%=1 To 22
If Sc$(Z%,Zz%,1)="_"
Inc Pts%
Endif
Next Z%
Next Zz%
Deftext ,,,4
Graphmode 2
For Z%=0 To Norizz%
Text Val(C$(Z%,0))*20+81,(Val(C$(Z%,1))*20+89)/2," "
Next Z%
For Z%=Norizz%+1 To Ntot%
Text Val(C$(Z%,0))*20+81,(Val(C$(Z%,1))*20+89)/2," "
Next Z%
Deftext ,,,13
Graphmode 1
Return
Procedure No_box(Si_no%)
Dpoke Intin,Si_no%
Vdisys 104
Return
Procedure Schema
Alert 3,"Choose your own difficulty level:",K%,"Simple|Average|Hard",K%
Deftext ,,,4
Text 135,12/2,"h "+Left$(Time$,5)
Text 430,12/2,"Points = 0 "
Deftext ,,,13
Return
Procedure Pulisci
For Zz%=2 To 3
Print At(15,Zz%);Space$(52)
Next Zz%
Return
Procedure Oriz_vert
Repeat
Until Mousek
X%=Trunc(Mousex-80)/20
Y%=Trunc(Mousey-80/2)/(20/2)
Print At(15,2);Space$(52)
Print At(15,2);"Coordinates are: X=";X%;", Y=";Y%;" save them (Y/n)?";
Zz%=Inp(2)
If Zz%<>110 And Zz%<>78 And X%>0 And X%<23 And Y%>0 And Y%<13
Pbox X%*20+83,Y%*20+83/2,X%*20+97,Y%*20+97/2
Print At(15,3);Space$(52)
Print At(15,3);"Definitn: ";Z%+1;": ";
Form Input 37,B$
Print #1,X%;",";Y%;",";B$;",";
Repeat
Print At(15,3);Space$(52)
Print At(15,3);"Solution: ";Z%+1;": ";
Form Input 22,B$
Until Len(B$)>1
Print #1,Upper$(B$);",";Len(B$)
@Pulisci
Else
Dec Z%
Endif
Return
Procedure Pro_tect
'
' SORRY !! ;-)
'
Return
Procedure Init
Setcolor 3,1,1,1
Setcolor 2,5,2,7
Setcolor 1,1,1,1
Return
|
| - MAIL TO ME - |