'===========================================================================
' Subject: ICON MAKER V1.0                   Date: 08-16-96 (09:25)       
' Author:  Claude Gagn‚                      Code: QB, QBasic, PDS        
' Origin:  cgagne@globalserve.on.ca        Packet: GRAPHICS.ABC
'===========================================================================
'****************************************************************************
'*                     [ Icon maker  Version 1.0 ]                          *
'*                   [ Claude Gagn‚, Toronto, 1996 ]                        *
'*            [ You can Email me at: cgagne@globalserve.on.ca ]             *
'*                                                                          *
'*     [ You can modify this program but please, give me some credits !]    *
'*                                                                          *
'*                [ This program make 50 X 50 pixels icons ]                *
'*            [ You can load those icon by using BLOAD command ]            *
'*                                                                          *
'*                 The mouse routines have been taken from                  *
'*                        Le Grand livre du QBASIC                          *
'*                         (c) Micro Application                            *
'*                                  1992                                    *
'****************************************************************************

DECLARE SUB fenetre (xup%, yup%, xdown%, ydown%, aspect%, couleur%)
DEFINT A-Z

DECLARE SUB initsouris ()
DECLARE SUB souris (OnOff%)
DECLARE SUB FormeSouris (SoftHard%, BMasque%, CMasque%)
DECLARE SUB SetSouris (X%, Y%)
DECLARE SUB TempoSouris (Tempo%)
DECLARE SUB zonexsouris (X1%, x2%)
DECLARE SUB zoneysouris (Y1%, Y2%)
DECLARE SUB getsouris (Mode%)
DECLARE SUB attendrelachebouton ()
DECLARE SUB attenddeplacement (Mode%)


DECLARE SUB ReadData ()
DECLARE FUNCTION Interr% (Num%, ax%, bx%, cx%, dx%)

DECLARE SUB ABSOLUTE (Fonction%, par1%, par2%, par3%, adr%)



'**********  d‚finir les variables globales  **********

DIM SHARED sourisx%, sourisy%, sourisk%       '*** position et bouton de la souris

DIM SHARED PM%(45)                      '** tableau pour le programme machine
ReadData                                '** lire le programme machine





SCREEN 12
initsouris
CLS

ON ERROR GOTO gestion

DIM tampon(1 TO 1432)

CALL fenetre(0, 0, 639, 479, 1, 7)
CALL fenetre(10, 10, 270, 270, 0, 0)
CALL fenetre(280, 10, 340, 70, 0, 0)

CALL fenetre(286, 16, 335, 65, 1, 7)
GOSUB miseajour

CALL fenetre(280, 235, 629, 270, 0, 0)   ' FENETRE COULEUR

FOR c = 1 TO 16
LINE (c * 20 + 280, 240)-(c * 20 + 300, 265), c - 1, BF
NEXT c

CALL fenetre(280, 80, 340, 140, 0, couleur1)  ' fenetre couleur1
CALL fenetre(280, 150, 340, 210, 0, couleur2) ' fenetre couleur2

CALL fenetre(350, 10, 629, 225, 0, 0)    ' FENETRE FONCTIONS

CALL fenetre(10, 280, 629, 469, 0, 0)    ' FENETRE TEXTE

LOCATE 2, 46: COLOR 14: PRINT "Functions List"
COLOR 15
LOCATE 3, 46: PRINT "F1 - New Icon"
LOCATE 4, 46: PRINT "F2 - Save"
LOCATE 5, 46: PRINT "F3 - Load"
COLOR 7
LOCATE 6, 46: PRINT "F4 - Not Avail."
COLOR 15
LOCATE 7, 46: PRINT "F5 - Shadow (Up)"
LOCATE 8, 46: PRINT "F6 - Shadow (Down)"
LOCATE 9, 46: PRINT "F7 - Shadow (Left)"
LOCATE 10, 46: PRINT "F8 - Shadow (right)"
LOCATE 11, 46: PRINT "F9 - Erase/Fill"
COLOR 7
LOCATE 12, 46: PRINT "F10 - Not avail."
COLOR 15
LOCATE 13, 46: PRINT "ESC => exit"


souris 1
DO
getsouris 0
clavier$ = UCASE$(INKEY$)

IF clavier$ = CHR$(0) + CHR$(59) THEN

CALL fenetre(286, 16, 335, 65, 1, couleur1)
GOSUB miseajour
END IF


IF clavier$ = CHR$(0) + CHR$(60) THEN GOSUB sauvegarde
IF clavier$ = CHR$(0) + CHR$(61) THEN GOSUB chargement
IF clavier$ = CHR$(0) + CHR$(62) THEN GOSUB changercouleur
IF clavier$ = CHR$(0) + CHR$(63) THEN GOSUB ombrerhaut
IF clavier$ = CHR$(0) + CHR$(64) THEN GOSUB ombrerbas
IF clavier$ = CHR$(0) + CHR$(65) THEN GOSUB ombrergauche
IF clavier$ = CHR$(0) + CHR$(66) THEN GOSUB ombrerdroite
IF clavier$ = CHR$(0) + CHR$(67) THEN GOSUB remplissage
IF sourisk% = 1 THEN
IF sourisx% > 285 AND sourisy% > 235 AND sourisx% < 624 AND sourisy% < 265 THEN
souris 0
couleur1 = POINT(sourisx%, sourisy%)
CALL fenetre(280, 80, 340, 140, 0, couleur1)
souris 1
END IF

IF sourisy% AND sourisx% > 285 AND sourisy% > 235 AND sourisx% < 624 AND sourisy% < 265 THEN
souris 0
couleur2 = POINT(sourisx%, sourisy%)
CALL fenetre(280, 150, 340, 210, 0, couleur2)
souris 1
END IF

FOR X = 1 TO 50
FOR Y = 1 TO 50

IF sourisx% > X * 5 + 10 AND sourisy% > Y * 5 + 10 AND sourisx% < X * 5 + 15 AND sourisy% < Y * 5 + 15 THEN
souris 0
LINE (X * 5 + 11, Y * 5 + 11)-(X * 5 + 14, Y * 5 + 14), couleur1, BF
PSET (285 + X, 15 + Y), couleur1
souris 1
EXIT FOR
EXIT FOR
END IF

IF sourisy% AND sourisx% > X * 5 + 10 AND sourisy% > Y * 5 + 10 AND sourisx% < X * 5 + 15 AND sourisy% < Y * 5 + 15 THEN
souris 0
LINE (X * 5 + 11, Y * 5 + 11)-(X * 5 + 14, Y * 5 + 14), couleur2, BF
PSET (285 + X, 15 + Y), couleur2
souris 1
EXIT FOR
EXIT FOR
END IF

NEXT Y
NEXT X
END IF
LOOP WHILE clavier$ <> CHR$(27)
souris 0
CLS
END

miseajour:
souris 0
FOR X = 1 TO 50
FOR Y = 1 TO 50
LINE (X * 5 + 11, Y * 5 + 11)-(X * 5 + 14, Y * 5 + 14), POINT(285 + X, 15 + Y), BF
NEXT Y
NEXT X
souris 1
RETURN

ombrerhaut:
souris 0

FOR X = 1 TO 50
FOR Y = 1 TO 50

IF POINT(285 + X, 15 + Y) = couleur1 AND POINT(285 + X, 14 + Y) <> couleur1 THEN
PSET (285 + X, 14 + Y), couleur2
END IF

NEXT Y
NEXT X

GOSUB miseajour
souris 1
RETURN

ombrerbas:
souris 0

FOR X = 1 TO 50
FOR Y = 1 TO 50

IF POINT(285 + X, 15 + Y) = couleur1 AND POINT(285 + X, Y + 16) <> couleur1 THEN
PSET (285 + X, 16 + Y), couleur2
END IF

NEXT Y
NEXT X

GOSUB miseajour
souris 1
RETURN

ombrergauche:
souris 0

FOR X = 1 TO 50
FOR Y = 1 TO 50

IF POINT(285 + X, 15 + Y) = couleur1 AND POINT(284 + X, 15 + Y) <> couleur1 THEN
PSET (284 + X, 15 + Y), couleur2
END IF

NEXT Y
NEXT X

GOSUB miseajour
souris 1
RETURN

ombrerdroite:
souris 0

FOR X = 1 TO 50
FOR Y = 1 TO 50

IF POINT(285 + X, 15 + Y) = couleur1 AND POINT(286 + X, 15 + Y) <> couleur1 THEN
PSET (286 + X, 15 + Y), couleur2
END IF

NEXT Y
NEXT X

GOSUB miseajour
souris 1
RETURN

changercouleur:
souris 0

FOR X = 1 TO 50
FOR Y = 1 TO 50

IF POINT(285 + X, 15 + Y) = couleur1 THEN
PSET (285 + X, 15 + Y), couleur2
END IF

NEXT Y
NEXT X

GOSUB miseajour
souris 1
RETURN

sauvegarde:
souris 0
LOCATE 20, 5: PRINT STRING$(65, 255);
LOCATE 20, 5: LINE INPUT "Sauvegarde [.ICO]: "; fichier$
IF LEN(fichier$) = 0 THEN GOTO finsauvegarde

GET (286, 16)-(335, 65), tampon

DEF SEG = VARSEG(tampon(1))
BSAVE fichier$ + ".ICO", VARPTR(tampon(1)), 1432
DEF SEG
BEEP

finsauvegarde:
LOCATE 20, 5: PRINT STRING$(65, 255);
souris 1
RETURN

chargement:
souris 0
LOCATE 20, 5: PRINT STRING$(65, 255);
LOCATE 20, 5: LINE INPUT "Chargement [.ICO]: "; fichier$
IF LEN(fichier$) = 0 THEN GOTO finchargement

DEF SEG = VARSEG(tampon(1))
BLOAD fichier$ + ".ICO", VARPTR(tampon(1))
DEF SEG

PUT (286, 16), tampon, PSET

GOSUB miseajour

BEEP

finchargement:
LOCATE 20, 5: PRINT STRING$(65, 255);
souris 1
RETURN


remplissage:

souris 0

FOR X = 1 TO 50
FOR Y = 1 TO 50

PSET (285 + X, 15 + Y), couleur1

NEXT Y
NEXT X

GOSUB miseajour
souris 1
RETURN

gestion:
BEEP
BEEP
RESUME NEXT


MS.Data:        '***** DATA du programme machine pour Interr%()
 DATA 55,8b,ec,56,57            'sauver le registre
 DATA 8b,76,0c,8b,04            'chercher AX … DX
 DATA 8b,76,0a,8b,1c
 DATA 8b,76,08,8b,0c
 DATA 8b,76,06,8b,14
 DATA cd,21                     'INT 21 (num‚ro modifi‚ !)
 DATA 8b,76,0c,89,04            'r‚‚crire AX … DX
 DATA 8b,76,0a,89,1c
 DATA 8b,76,08,89,0c
 DATA 8b,76,06,89,14
 DATA 5f,5e,5d                  'chercher le registre
 DATA ca,08,00                  'RETF 8  =>  fin
 DATA #


SUB attenddeplacement (Mode%)
'** Attendre le d‚placement de la souris ou l'appui/relƒchement du bouton

 getsouris Mode%
 X% = sourisx%: Y% = sourisy%: K% = sourisk%

 DO
  getsouris Mode%
 LOOP UNTIL X% <> sourisx% OR Y% <> sourisy% OR K% <> sourisk%

END SUB

SUB attendrelachebouton
'** Attendre le relƒchement du bouton de la souris

 WHILE sourisk%
  getsouris 0
 WEND

END SUB

SUB fenetre (xup, yup, xdown, ydown, aspect, couleur)


IF aspect <= 0 THEN
        surface = 8
        ombre = 15
        lumiere = 8
END IF

IF aspect >= 1 THEN
        surface = 7
        ombre = 8
        lumiere = 15
END IF

LINE (xup, yup)-(xdown, ydown), surface, BF

LINE (xup, yup)-(xdown, ydown), ombre, B
LINE (xup + 1, yup + 1)-(xdown - 1, ydown - 1), ombre, B

LINE (xup, yup)-(xup, ydown), lumiere
LINE (xup + 1, yup + 1)-(xup + 1, ydown - 1), lumiere

LINE (xup, yup)-(xdown, yup), lumiere
LINE (xup + 1, yup + 1)-(xdown - 1, yup + 1), lumiere

LINE (xup + 3, yup + 3)-(xdown - 3, ydown - 3), couleur, BF



END SUB

SUB FormeSouris (SoftHard%, BMasque%, CMasque%)
'** D‚finir l'apparition du curseur de la souris

 R% = Interr%(&H33, 10, SoftHard%, BMasque%, CMasque%)      '** d‚finir FormeSouris

END SUB

SUB getsouris (Mode%)
'** Chercher dans SourisX%, SourisY% et SourisK% la position de la souris et l'‚tat du bouton

  R% = Interr%(&H33, 3, bx%, cx%, dx%)

  sourisk% = bx%                  '** bouton (1=gauche, 2=droit)
 
  IF Mode% THEN
   sourisx% = cx% / 16 + 1         '** position X (mode texte)
   sourisy% = dx% / 16 + 1          '** position Y (mode texte)
  ELSE
   sourisx% = cx%                  '** position X (mode graphique)
   sourisy% = dx%                  '** position Y (mode graphique)
  END IF

END SUB

SUB initsouris
'** Initialiser le gestionnaire de la souris

 R% = Interr%(&H33, 0, bx%, cx%, dx%)   '** initialiser le gestionnaire de la souris

END SUB

FUNCTION Interr% (Num%, ax%, bx%, cx%, dx%)
'** R‚aliser l'interruption num‚ro Num% avec les contenus des registres de AX% … DX%

 IF PM%(0) = 0 THEN                     '** PM%() est initialis‚ ?
  PRINT "ERREUR : programme machine absent ! Arrˆt!"
  END
 END IF

 DEF SEG = VARSEG(PM%(0))               '** d‚finir le segment
 POKE VARPTR(PM%(0)) + 26, Num%         '** mettre en oeuvre le num‚ro de l'interruption

 CALL ABSOLUTE(ax%, bx%, cx%, dx%, VARPTR(PM%(0))) '** appel

 Interr% = ax%                          '** valeur retourn‚e prise dans AX%

END FUNCTION

SUB ReadData
'** Lire les DATA pour le programme machine dans PM%()

 RESTORE MS.Data
 DEF SEG = VARSEG(PM%(0))

 FOR i% = 0 TO 99
  READ Octet$
  IF Octet$ = "#" THEN EXIT FOR
  POKE VARPTR(PM%(0)) + i%, VAL("&H" + Octet$)
 NEXT i%

END SUB

SUB SetSouris (X%, Y%)
'** D‚finir la position du pointeur de la souris
'** X% et Y% sont en coordonn‚es caractŠres en mode texte

 R% = Interr%(&H33, 4, bx%, X% * 16 - 16, Y% * 16 - 16)

END SUB

SUB souris (OnOff%)
'** Allumer / Eteindre le pointeur de la souris (0=‚teint, 1=allum‚)

 IF OnOff% = 0 THEN OnOff% = 2 ELSE OnOff% = 1
 R% = Interr%(&H33, OnOff%, bx%, cx%, dx%)

END SUB

SUB TempoSouris (Speed%)
'** D‚finir la vitesse de la souris (0=rapide, 100=trŠs lente)

 R% = Interr%(&H33, 15, bx%, Speed%, Speed% * 2)

END SUB

SUB zonexsouris (X1%, x2%)
'** D‚finir la zone de d‚placement horizontal de la souris de X1% … X2%
'** X1% et X2% sont des coordonn‚es caractŠres en mode texte

 R% = Interr%(&H33, 7, 0, X1% * 16 - 16, x2% * 16 - 16)

END SUB

SUB zoneysouris (Y1%, Y2%)
'** D‚finir la zone de d‚placement vertical de la souris de Y1% … Y2%
'** Y1% et Y2% sont des coordonn‚es caractŠres en mode texte

 R% = Interr%(&H33, 8, bx%, Y1% * 16 - 16, Y2% * 16 - 16)

END SUB