|
Voici une petite application de programme de dessin Bitmap utilisant le clavier et non la souris pour effectuer des dessins.
J'ai écrit se petit programme lorsque j'étais encore très jeune, mais il est toujours intéressant de voir l'évolution qu'on a effectuer...
Le code source BASICA/GWBASIC de l'application:
10 ON ERROR GOTO 990
20 DIM T%(17),TA%(8001),TP%(8001):DEFINT A-Z
30 XP=159:YP=99:CV=1:MX=159:MY=99:CB=0:BX=XP:BY=YP
40 A=0:B=0:C=0:D=0:E=0:L=0:R=7:T=0:TX%=159:TY%=99
50 A$="":B$="Baiss‚":C$="Crayon ":H$=CHR$(0)+"H":L$="Lever":M$=CHR$(13):P$=CHR$(0)+"P":T$="º":Z$=CHR$(27)
60 KEY OFF:TROFF
70 SCREEN 1,1:CLS
80 GOSUB 1890
90 PUT(0,0),TA%,PSET
100 IF XP<0 THEN XP=319 ELSE IF XP>319 THEN XP=0
110 IF YP<0 THEN YP=199 ELSE IF YP>199 THEN YP=0
120 FX=XP:FY=YP:BX=XP:BY=YP
130 GOSUB 1660
140 IF A$=Z$THEN GOSUB 570
150 IF A$=CHR$(34)THEN PUT(XP,YP),TP%,PRESET
160 IF A$="A"THEN 610
170 IF A$="B"THEN CB=1
180 IF A$="C"THEN GOSUB 830
190 IF A$="F"THEN 460
200 IF A$="G"OR A$=CHR$(8)OR A$="5"OR A$=CHR$(0)+"G"THEN XP=159:YP=99
210 IF A$="J"THEN GOSUB 920
220 IF A$="L"THEN CB=0
230 IF A$="O"OR A$="#"THEN LINE(MX,MY)-(XP,YP),CV,B
240 IF A$="P"THEN PSET(XP,YP),CV
250 IF A$="Q"OR A$="7" THEN YP=0:XP=0
260 IF A$="R"THEN MX=XP:MY=YP
270 IF A$="S"THEN MX=XP:MY=YP:PSET(XP,YP),CV
280 IF A$="T"OR A$="_"THEN LINE(MX,MY)-(XP,YP),CV
290 IF A$="V"OR A$=CHR$(0)+"Q"THEN XP=159:YP=199
300 IF A$="X"THEN 1180
310 IF A$="Z"OR A$="3"THEN XP=319:YP=199
320 IF A$="9"OR A$="/"THEN XP=319:YP=0
330 IF A$="1"OR A$=","THEN XP=0:YP=199
340 IF A$="@"OR A$=")"THEN 510
350 IF A$=";"THEN LINE(MX,MY)-(XP,YP),CV,,&HABAB
360 IF A$=":"THEN LINE(MX,MY)-(XP,YP),CV,,&HAAAA
370 IF A$=CHR$(0)+"I"OR A$="^"THEN XP=159:YP=0
380 IF A$=CHR$(0)+"O"THEN 570
390 IF A$=CHR$(0)+"R"OR A$="("OR A$="!"THEN 460
400 IF A$="["THEN XPUT1=XP:YPUT1=YP
410 IF A$="]"THEN XPUT2=XP:YPUT2=YP:GET(XPUT1,YPUT1)-(XPUT2,YPUT2),TP%
420 IF A$="\"THEN PUT(XP,YP),TP%,PSET
430 IF A$="'"THEN PUT(XP,YP),TP%,OR
440 IF CB THEN LINE(BX,BY)-(XP,YP),CV:BX=XP:BY=YP
450 GOTO 100
460 GOSUB 1890:SCREEN 0,0,0,0:WIDTH 80:COLOR 15,1,1:CLS:LOCATE 2,30:PRINT"Liste des dessins":PRINT STRING$(80,"_"):VIEW PRINT 5 TO 23:FILES:VIEW PRINT 1 TO 24
470 LOCATE 24,1:INPUT"Le nom du dessin est = ",NOM$
480 IF NOM$=""THEN SCREEN 1,1:GOTO 90
490 GOSUB 1160:SCREEN 1,1:DEF SEG:BLOAD NOM$,VARPTR(TA%(0)):PUT(0,0),TA%,PSET
500 GOTO 100
510 GOSUB 1890:LOCATE 12,1:INPUT"Sous quelle nom nom dois-je le sauver = ",NOM$
520 IF NOM$=""THEN 90
530 LOCATE 15,1:PRINT"Je sauvegarde d'une maniere : "M$"(R)eguliere/(C)ompresser":GOSUB 1880:PUT(0,0),TA%,PSET
550 IF A$=Z$THEN 90 ELSE IF A$="R"OR A$="r"THEN DEF SEG=&HB800BSAVE NOM$,0,16384:GOTO 90 ELSE IF A$="C"OR A$="c"THEN DEF SEG:BSAVE NOM$,VARPTR(TA%(0)),16004:GOTO 90
560 GOTO 530
570 GOSUB 1890:LINE(60,60)-(259,120),0,BF:LINE(64,64)-(255,116),3,B:LOCATE 11,12:PRINT"Est-tu certain que":LOCATE 12,11:PRINT"tu veux quitter (O/N)":LOCATE 14,19:PRINT"? ";
580 C=(C+1)AND 31:IF(C=0)THEN PRINT"_"+CHR$(29); ELSE IF(C=15)THEN PRINT" "+CHR$(29);
590 A$=INKEY$:IF A$=""THEN 580
600 IF(A$="O")OR(A$="o")THEN SCREEN 0,0,0,0:WIDTH 80:COLOR 7,0,0:CLS:KEY ON:END ELSE PUT(0,0),TA%,PSET:RETURN
610 GOSUB 1890:SCREEN 0,0,0,0:WIDTH 80:COLOR 15,1,1:CLS
620 LOCATE 1,33:PRINT"Info-Creation"STRING$(80,"_")M$M$
630 PRINT"A - Aide
640 PRINT"B - "C$B$
650 PRINT"C - Change la couleur courant
660 PRINT"F - Recherche un Fichier
670 PRINT"G - Positionne le pointeur au centre de l'‚cran
680 PRINT"J - Peint une zone de l'‚cran
690 PRINT"L - "C$L$
700 PRINT"O - Trace une boite
710 PRINT"P - Affiche un Point
720 PRINT"Q - Positionne le pointeur dans le cote gauche superieur
730 PRINT"R - Sauvegarde en memoire la position de depart
740 PRINT"S - Sauvegarde en memoire la position de depart avec un point
750 PRINT"T - Trace une ligne de la couleur specifier
760 PRINT"V - Deplacement du pointeur dans le centre inferieur
770 PRINT"X - Affiche le menu
780 PRINT"Z - Deplacement du pointeur dans le coin inferieur droit
790 PRINT"( - Chercher un dessin
800 PRINT") - Sauver un dessin
810 LOCATE 25,1:PRINT"Presse une touche pour retouner a l'editeur ...";
820 IF INKEY$=""THEN 820 ELSE SCREEN 1,1:GOTO 90
830 GOSUB 1890:LINE(0,99)-(319,199),0,BF:LINE(4,103)-(314,194),3,B
840 LINE(10,110)-(160,135),CV,BF:LOCATE 16,23:PRINT"Couleur courant"
850 LINE(10,145)-(160,170),0,BF:LINE(10,145)-(160,170),3,B:LOCATE 20,23:PRINT"Texture courant":IF T$=CHR$(0)THEN PAINT(11,146),0,3 ELSE PAINT(11,146),T$,3
860 LOCATE 23,3:PRINT C$": ";:IF CB THEN PRINT B$;ELSE PRINT L$;
870 PRINT" Esc = Retour"
880 LOCATE 24,3:PRINT"X ="XP" Y ="YP" C ="CV" T ="ASC(T$);
890 GOSUB 1880
900 IF A$="C"OR A$="c"THEN CV=(CV+1)AND 3 ELSE IF A$="T"OR A$="t"THEN T$=CHR$((ASC(T$)+1)AND 255)ELSE IF A$=Z$THEN PUT(0,0),TA%,PSET:RETURN ELSE 890
910 GOTO 840
920 GOSUB 1890:LINE(10,10)-(160,35),3,B:LOCATE 4,23:PRINT"Texture de peinte":LINE(10,45)-(160,70),CV,BF:LOCATE 8,23:PRINT"Couleur d'arret":LOCATE 12,1:PRINT"Est-tu certain que tu veux peinturer (O/N)":LOCATE 14,19:PRINT"? ";
930 LINE(11,11)-(159,34),0,BF:IF T$=CHR$(0)THEN PAINT(11,11),0,3 ELSE PAINT(11,11),T$,3
940 C=(C+1)AND 31:IF(C=0)THEN PRINT"_"+CHR$(29); ELSE IF(C=15)THEN PRINT" "+CHR$(29);
950 A$=INKEY$:IF A$=""THEN 940
960 IF(A$="O")OR(A$="o")THEN A$="":GOTO 970 ELSE PUT(0,0),TA%,PSET:RETURN
970 PUT(0,0),TA%,PSET:IF T$=CHR$(0)THEN PAINT(XP,YP),0,CV ELSE PAINT(XP,YP),T$,CV
980 RETURN
990 SCREEN 0,0,0,0:WIDTH 80:COLOR 15,1,1:CLS:KEY ON
1000 IF(ERR=7)THEN PRINT"Erreur de memoire"M$"Ce programme nessecite les 65536 octets de memoire disponible":RESUME 1060
1010 IF(ERR=53)THEN 1070
1020 IF(ERR=5)AND(ERL=420)THEN 100
1030 PRINT"Erreur numero :"ERR
1040 PRINT"A la ligne :"ERL,M$STRING$(25,"-")
1050 RESUME 1060
1060 END
1070 LOCATE 1,30:PRINT"Fichier incorrect"STRING$(80,"_")
1080 LOCATE 8,8:PRINT"1 - Aborde"
1090 LOCATE 10,8:PRINT"2 - Retrait"
1100 LOCATE 12,8:PRINT"3 - Ignore"
1110 LOCATE 16,5,1:PRINT"Votre choix ?";
1120 A$=INKEY$:IF A$=""THEN 1120
1130 IF A$=Z$THEN 90
1140 IF A$="1"THEN SCREEN 1,1:RESUME 90 ELSE IF A$="2"THEN SCREEN 1,1:PUT(0,0),TA%,PSET:RESUME NEXT ELSE IF A$="3"THEN RESUME
1150 GOTO 1120
1160 'OPEN"O",#1,NOM$
1170 L=16384:RETURN
1180 GOSUB 1890:LINE(75,35)-(245,155),0,BF:LINE(80,40)-(240,150),1,B
1190 LOCATE 7,18:PRINT"Menu
1200 LOCATE 9,12:PRINT"Boite
1210 LOCATE 10,12:PRINT"Couleur/Texture
1220 LOCATE 11,12:PRINT"Cercle
1230 LOCATE 12,12:PRINT C$;:IF CB THEN PRINT B$ELSE PRINT L$
1240 LOCATE 13,12:PRINT"Peint
1250 LOCATE 14,12:PRINT"Point
1260 LOCATE 15,12:PRINT"Ligne
1270 LOCATE 16,12:PRINT"Chercher
1280 LOCATE 17,12:PRINT"Sauver
1290 LOCATE 18,12:PRINT"Quitter
1300 GET(75,35)-(245,155),TP%:PUT(75,35),TP%,PRESET:M=0
1310 N=64+M*8:GET(85,N)-(235,N+7),TP%
1320 PUT(85,N),TP%,PRESET
1330 GOSUB 1880
1340 PUT(85,N),TP%,PSET
1350 IF A$=H$THEN M=M-1 ELSE IF A$=P$THEN M=M+1
1360 IF(M>9)THEN M=0 ELSE IF(M<0)THEN M=9
1370 IF A$=Z$THEN 90 ELSE IF M$=A$THEN PUT(0,0),TA%,PSET:ON M+1 GOTO 1390,1430,1440,1480,1520,1550,1580,460,510,1620
1380 GOTO 1310
1390 S=0
1400 GOSUB 1640
1410 IF A$=M$AND S THEN LINE(MX,MY)-(XP,YP),CV,B:S=0 ELSE IF A$=M$THEN MX=XP:MY=YP:S=1 ELSE IF A$="C"THEN GOSUB 830 ELSE IF A$=Z$THEN 1180
1420 GOTO 1400
1430 GOSUB 830:GOTO 1180
1440 C=0
1450 GOSUB 1640
1460 IF A$=M$AND C THEN CIRCLE(MX,MY),ABS(MX-XP)+ABS(MY-YP),CV,,,20/32:C=0 ELSE IF A$=M$THEN MX=XP:MY=YP:C=1 ELSE IF A$="C"THEN GOSUB 830 ELSE IF A$=Z$THEN 1180
1470 GOTO 1450
1480 C=0:BX=159:BY=99
1490 GOSUB 1640:LINE(BX,BY)-(XP,YP),CV:BX=XP:BY=YP
1500 IF A$="C"THEN GOSUB 830 ELSE IF A$=Z$THEN 1180
1510 GOTO 1490
1520 GOSUB 1640
1530 IF M$=A$THEN GOSUB 920 ELSE IF A$="C"THEN GOSUB 830 ELSE IF A$=Z$THEN 1180
1540 GOTO 1520
1550 GOSUB 1640
1560 IF M$=A$THEN PSET(XP,YP),CV ELSE IF A$="C"THEN GOSUB 830 ELSE IF A$=Z$THEN 1180
1570 GOTO 1550
1580 C=0
1590 GOSUB 1640
1600 IF A$=M$AND C THEN LINE(MX,MY)-(XP,YP),CV:C=0 ELSE IF M$=A$THEN MX=XP:MY=YP:C=1:ELSE IF A$="C"THEN GOSUB 830 ELSE IF A$=Z$THEN 1180
1610 GOTO 1590
1620 GOSUB 570:GOTO 1180
1630 'Sous-Programme
1640 IF(XP<0)THEN XP=319 ELSE IF(XP>319)THEN XP=0
1650 IF(YP<0)THEN YP=199 ELSE IF(YP>199)THEN YP=0
1660 TX%=XP-4:IF(TX%<0)THEN TX%=0
1670 IF(TX%>311)THEN TX%=311
1680 TY%=YP-3:IF(TY%<0)THEN TY%=0
1690 IF(TY%>193)THEN TY%=193
1700 GET(TX%,TY%)-(TX%+8,TY%+6),T%
1710 DRAW"BM"+STR$(XP)+","+STR$(YP)+"C=IC;ND2NL2NR2U2":IC=(IC+1)AND 3
1720 A$=INKEY$:IF A$=""THEN 1710
1730 TX%=XP-4:IF(TX%<0)THEN TX%=0
1740 IF(TX%>311)THEN TX%=311
1750 TY%=YP-3:IF TY%<0 THEN TY%=0
1760 IF(TY%>193)THEN TY%=193
1770 PUT(TX%,TY%),T%,PSET
1780 IF A$="2"THEN YP=YP+10
1790 IF A$="4"THEN XP=XP-10
1800 IF A$="6"THEN XP=XP+10
1810 IF A$="8"THEN YP=YP-10
1820 IF A$=H$THEN YP=YP-1
1830 IF A$=CHR$(0)+"K"THEN XP=XP-1
1840 IF A$=CHR$(0)+"M"THEN XP=XP+1
1850 IF A$=P$THEN YP=YP+1
1860 IF(A$>"`")AND(A$<"{")THEN A$=CHR$(ASC(A$)-32)
1870 RETURN
1880 A$=INKEY$:IF A$=""THEN 1880 ELSE RETURN
1890 GET(0,0)-(319,199),TA%:RETURN
|
|
