-
Notifications
You must be signed in to change notification settings - Fork 0
/
Copy pathCREADESS.BAS
120 lines (120 loc) · 5.57 KB
/
CREADESS.BAS
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
0 KEY OFF:SCREEN 2:SCREEN 0:CLS:COLOR 13:PRINT :PRINT :PRINT "-1- POUR REGLER L'IMPRIMANTE ":PRINT "-2- POUR COMMANCER LE PROGRAME ":PRINT " <ESC> POUR FIN "
1 PRINT:PRINT "votre choix :"
2 A$=INKEY$:IF A$=CHR$(27) THEN END ELSE IF A$="" THEN 2
3 IF A$="1" OR A$="&" THEN PRINT "app sur une touche lorsque vous serez pret" ELSE 5
4 A$=INKEY$:IF A$="" THEN 4 ELSE LPRINT CHR$(27);"!":LPRINT CHR$(18):GOTO 0
5 IF A$="2" OR A$="`" OR A$="‚" THEN 10
10 CLEAR,,,32768!:SCREEN 5:CLS:KEY 11,CHR$(253):KEY 12,CHR$(221)
11 AV=1:X=160:Y=100:Q=12:K=2:DIM M(14000)
20 X$=INKEY$
30 IF X$="'" OR X$="4" OR X$="|" THEN X=X-AV
40 IF X$="6" THEN X=X+AV
41 IF X$="8" OR X$="~" OR X$="!" THEN Y=Y-AV
42 IF X$="2" OR X$="`" OR X$="‚" THEN Y=Y+AV
43 IF X$=" " AND O=0 THEN X1=X:Y1=Y:GOTO 20
44 IF X$="a" OR X$="A" THEN RUN 10
45 IF X$="0" OR X$="…" THEN O=0
46 IF X$=CHR$(27) THEN END
47 IF X$="1" OR X$="&" THEN X=X-AV:Y=Y+AV
48 IF X$="3" THEN X=X+AV:Y=Y+AV
49 IF X$="7" OR X$="Š" OR X$="\" THEN Y=Y-AV :X=X-AV
50 IF X$="9" OR X$="‡" THEN Y=Y-AV :X=X+AV
86 IF Y<2 THEN BEEP:Y=Y+AV
87 IF Y>170 THEN BEEP:Y=Y-AV
88 IF X>316 THEN BEEP:X=X-AV
89 IF X<2 THEN BEEP:X=X+AV
90 S(0)=POINT (X,Y):S(1)=POINT (X-1,Y):S(2)=POINT (X+1,Y):S(3)=POINT (X,Y+1):S(4)=POINT (X,Y-1)
91 PSET (X,Y),K:PSET (X-1,Y),K:PSET (X+1,Y),K:PSET (X,Y+1),K:PSET (X,Y-1),K
92 PSET (X,Y),S(0):PSET (X-1,Y),S(1):PSET (X+1,Y),S(2):PSET (X,Y+1),S(3):PSET (X,Y-1),S(4)
93 LOCATE 24,1
94 IF Q<> 0 AND Q<> 16 THEN COLOR Q:PRINT CHR$(8);" "; ELSE COLOR 13:PRINT "N";" ";
95 IF K<> 0 AND K<> 16 THEN COLOR K:PRINT CHR$(8); ELSE COLOR 13:PRINT "N";
102 GOSUB 1000
103 GOTO 20
1000 IF X$="b" OR X$="B" THEN 2000
1001 IF X$="c" OR X$="C" THEN 2010
1002 IF X$="l" OR X$="L" THEN 2050
1003 IF X$="p" OR X$="P" THEN 2060
1004 IF X$="k" OR X$="K" THEN 2070
1005 IF X$="d" OR X$="D" THEN 2080
1006 IF X$="m" OR X$="M" THEN 2090
1007 IF X$="n" OR X$="N" THEN 2100
1008 IF X$="f" OR X$="F" THEN 2120
1009 IF X$="q" OR X$="Q" THEN 2110
1010 IF X$="z" OR X$="Z" THEN CLS
1011 IF X$="w" OR X$="W" THEN 2130
1012 IF X$="v" OR X$="V" THEN 2140
1013 IF X$="g" OR X$="G" THEN 2160
1014 IF X$="t" OR X$="T" THEN 2170
1015 IF X$="s" OR X$="S" THEN 2180
1016 IF X$="e" OR X$="E" THEN 2200
1017 IF X$="r" OR X$="R" THEN 2190
1110 IF O=1 THEN 2000
1111 IF O=2 THEN 2010
1112 IF O=3 THEN 2050
1113 IF O=4 THEN 2060
1114 IF O=5 THEN 2090
1115 IF O=6 THEN 2140
1116 IF O=7 THEN 2170
1117 IF O=8 THEN 2200
1997 RETURN
2000 LINE (X1,Y1)-(X,Y),K,B:LINE (X1,Y1)-(X,Y),0,B
2005 IF X$=" " THEN LINE (X1,Y1)-(X,Y),K,B:O=0 ELSE O=1
2006 RETURN
2010 R=X-X1:IF R<0 THEN R=X1-X
2030 CIRCLE (X1,Y1),R,K:CIRCLE (X1,Y1),R,0
2035 IF X$=" " THEN CIRCLE (X1,Y1),R,K:O=0 ELSE O=2
2040 RETURN
2050 LINE (X1,Y1)-(X,Y),K:LINE (X1,Y1)-(X,Y),0
2051 IF X$=" " THEN LINE (X1,Y1)-(X,Y),K:O=0 ELSE O=3
2052 RETURN
2060 IF X$=" " THEN PAINT (X,Y),Q,K:O=0 ELSE O=4
2061 RETURN
2070 K=K+1:IF K=17 THEN K=1:RETURN
2071 RETURN
2080 PSET (X,Y),K
2081 RETURN
2090 PSET(X1,Y1),K
2091 IF X$=" " THEN LINE (X1-1,Y1-1)-(X+1,Y+1),K,B ELSE O=5:RETURN
2092 W=X1-X:IF W<0 THEN W=X-X1
2093 W1=Y1-Y:IF X<0 THEN W1=Y-Y1
2094 IF (W*W1) > 10000 THEN LOCATE 24,1:PRINT " ERREUR : PAS ASSEZ DE CAPACITEZ !!! ";:FOR I=1 TO 1500 :NEXT :LOCATE 24,1:PRINT " ";:LINE (X1-1,Y1-1)-(X+1,Y+1),O,B:RETURN
2095 GET(X1,Y1)-(X,Y),M:LINE (X1-1,Y1-1)-(X+1,Y+1),0,B:O=0:M(1)=1:RETURN
2100 IF M(1)=1 THEN PUT (X,Y),M :RETURN
2101 LOCATE 23,1:PRINT " ERREUR : VOUS N'AVIER PAS ENREGISTRE DE DESSIN ";:FOR I=1 TO 1500:NEXT :LOCATE 23,1:PRINT " ";
2102 RETURN
2110 Q=Q+1:IF Q=>16 THEN Q=0
2111 RETURN
2120 CX=K+1:IF CX>=16 THEN CX=1
2121 IF K>=16 THEN K=0
2122 COLOR CX,K
2123 RETURN
2130 LOCATE 23,1:INPUT " N DE POINTS ",AV:LOCATE 24,1:PRINT " ";:LOCATE 23,1:PRINT " ":RETURN
2140 IF X$=" " AND DD=0 THEN BEEP :X2=X:Y2=Y:PSET(X1,Y1),K:PSET (X2,Y2),K:O=6:DD=1:RETURN
2141 IF X$=" " AND DD=1 THEN 2142 ELSE O=6:RETURN
2142 Y3=Y:X3=X:Y4=Y3:X4=X3+(Y3-Y2):X5=X4:Y5=Y2:X6=X1+(Y3-Y2):Y6=Y1:X7=X6:Y7=Y1+(Y3-Y2):X8=X1:Y8=Y7
2143 LINE (X2,Y2)-(X4,Y4),K,B:LINE (X1,Y1)-(X7,Y7),K,B:LINE -(X4,Y4),K:LINE (X3,Y3)-(X8,Y8),K:LINE (X2,Y2)-(X1,Y1),K:LINE (X5,Y5)-(X6,Y6),K
2154 DD=0:Y2=0:X2=0:X3=0:X4=0:X5=0:X6=0:X7=0:X8=0:Y3=0:Y4=0:Y5=0:Y6=0:Y7=0:Y8=0:O=0:RETURN
2160 LOCATE 23,1:COLOR 14:PRINT " app sur une touche pour effacer et une seconde pour reprendre ";
2161 A$=INKEY$:IF A$="" THEN 2161
2162 LOCATE 23,1:PRINT SPC(39);:LOCATE 24,1:PRINT SPC(39);
2163 A$=INKEY$:IF A$="" THEN 2163 ELSE RETURN
2170 O=7:IF X$<>" " THEN RETURN
2171 LX=INT(X/8)+1:LY=INT(Y/8)+1
2172 LOCATE 23,1:PRINT " VOTRE PHRASE ? (f12 fin,f11 correction)";
2173 COLOR K:LOCATE LY,LX
2174 A$=INKEY$:IF A$="" THEN 2174 ELSE IF ASC(A$)=221 THEN 2177 ELSE IF ASC(A$)=253 THEN LX=LX-1:IF LX=0 THEN LX=40:LY=LY-1:IF LY=0 THEN O=0:RETURN ELSE GOTO 2173 ELSE 2173
2175 PRINT A$;:LX=LX+1:IF LX=41 THEN LY=LY+1:LX=1:IF LY=22 THEN O=0:RETURN
2176 GOTO 2173
2177 LOCATE 23,1:PRINT SPC(39);" ";:O=0:RETURN
2180 DEF SEG=&HB800:LOCATE 23,1:COLOR 14:INPUT " Donnez un nom puis enter ";FI$
2181 IF LEN(FI$)>=9 THEN BEEP 2180
2182 LOCATE 23,1:PRINT SPC(39);:LOCATE 24,1:PRINT SPC(39);
2183 FI$=FI$+".im":BSAVE FI$,0,32768!:RETURN
2190 LOCATE 24,1:PRINT "ETES VOUS SUR ? O/N";
2191 A$=INKEY$:IF A$="" THEN 2191 ELSE IF A$="O" OR A$="o" THEN 2192 ELSE LOCATE 24,1:PRINT SPACE$(40);:RETURN
2192 DEF SEG=&HB800:CLS:FILES "*.im"
2193 INPUT "NOM DU FICHIER IMAGE ";FI$:IF LEN(FI$)>=9 THEN 2193 ELSE FI$=FI$+".im"
2194 BLOAD FI$:RETURN
2200 LOCATE 23,1:PRINT "F12 pour fin";:O=8:PSET(X,Y),K:IF X$=CHR$(221) THEN O=0:RETURN ELSE RETURN