home *** CD-ROM | disk | FTP | other *** search
/ Fujiology Archive / fujiology_archive_v1_0.iso / !FALCON / FANTOMAS / WORMHOLE.ZIP / WORMHOLE / WORMHOLE.LST next >
Encoding:
File List  |  1998-10-12  |  7.9 KB  |  219 lines
  1. ' *-----------------------------------------------*
  2. '                     ≡ WORMHOLE ≡
  3. '     version 1.00 pour ATARI ** FALCON 030 **
  4. '                        RVB/VGA
  5. '             © FANTOMAS / Février-Mars 98
  6. '    D'après un programme Quick Basic du groupe
  7. '              LUCIFER (Psycho BFG & 666)
  8. ' *-----------------------------------------------*
  9. '      http://perso.wanadoo.fr/michel.goux/
  10. '
  11. ON ERROR GOSUB fin                                ! Si erreur, fini.
  12. ON BREAK GOSUB fin                                ! Si Break, fini.
  13. '
  14. RESERVE 50000                                     ! Réserve mémoire.
  15. super%=GEMDOS(32,L:0)                             ! Mode Superviseur.
  16. resol&=XBIOS(88,W:-1)                             ! Sauve la résolution.
  17. sauve_ecr%=XBIOS(2)                               ! Sauve l'écran.
  18. buffer%=MALLOC(77824)                             ! Réserve une zone mémoire
  19. image%=buffer%+1024
  20. moniteur%=XBIOS(89)                               ! Type de moniteur.
  21. key|=BYTE{&H484}                                  ! Bloque le clic clavier.
  22. IF moniteur%=2                                    ! Moniteur VGA
  23.   ~XBIOS(5,L:image%,L:image%,W:3,W:&X100110011)   ! VGA: 320x240 256c.
  24. ELSE
  25.   ~XBIOS(5,L:image%,L:image%,W:3,W:&X11)          ! TV:  320x200 256c.
  26. ENDIF
  27. OUT 4,18                                          ! Bloque la souris.
  28. CLS                                               ! Efface l'écran.
  29. ' *--- Couleurs ---*
  30. {&HFFFF9800}=0                                    ! Couleur   0: noir.
  31. {&HFFFF9800+255*4}=&HFFFF00FF                     ! Couleur 255: blanc.
  32. FOR i=0 TO 15                                     ! Couleurs 16 à 31.
  33.   @def_color(16+i,(i+48)*4,(i+48)*4,(i+48)*4)
  34. NEXT i
  35. FOR i=1 TO 5                                      ! Couleurs 46 à 50.
  36.   @def_color(45+i,(i*12)*4,0,0)
  37. NEXT i
  38. FOR i=1 TO 50                                     ! Couleurs 151 à 200.
  39.   @def_color(i+150,(i+13)*4,(i+13)*4,0)
  40. NEXT i
  41. ' ****  Dessin du fond d'écran (Version escargot) ***
  42. IF NOT EXIST("\WORMHOLE\WORMHOLE.PI9")            ! Si il existe déjà ...
  43.   CLIP 0,0,320,200
  44.   n&=46                                           ! Couleur de début.
  45.   x=5
  46.   FOR i&=200 DOWNTO 40                            ! Tracé du 'tunnel'.
  47.     INC n&
  48.     IF n&=51
  49.       n&=46
  50.     ENDIF
  51.     x=x/1.003
  52.     FOR j&=1 TO 10
  53.       @cercle(160,i&,x,n&)
  54.       x=x*1.003
  55.     NEXT j&
  56.   NEXT i&
  57.   ' *--- Tracé de la sphère ---*
  58.   FOR i&=1 TO 49
  59.     @cercle(159,70,i&,200-i&)
  60.     @cercle(159,71,i&,200-i&)
  61.     @cercle(159,72,i&,200-i&)
  62.   NEXT i&
  63.   ' *--- Tracé du logo 'FANTOMAS' ---*
  64.   DEFFILL 0,2,8
  65.   PBOX 0,0,319,10
  66.   COLOR 1
  67.   PRINT AT(32,1);"FANTOMAS"
  68.   DEFFILL 1,2,8
  69.   FOR i=248 TO 319                                ! Le logo.
  70.     FOR j=0 TO 10
  71.       IF PTST(i,j)>0
  72.         PBOX (i-200)*2,j*2+50,(i-200)*2+2,j*2+52
  73.       ENDIF
  74.     NEXT j
  75.   NEXT i
  76.   FOR i=96 TO 224                                 ! Le contour.
  77.     FOR j=49 TO 75
  78.       IF PTST(i,j)<>255
  79.         IF PTST(i+1,j+1)=255
  80.           PSET i,j,50
  81.         ENDIF
  82.         IF PTST(i,j+1)=255 OR PTST(i+1,j)=255
  83.           PSET i,j,49
  84.         ENDIF
  85.         IF PTST(i-1,j+1)=15 OR PTST(i+1,j-1)=255
  86.           PSET i,j,48
  87.         ENDIF
  88.         IF PTST(i,j-1)=15 OR PTST(i-1,j)=255
  89.           PSET i,j,47
  90.         ENDIF
  91.         IF PTST(i-1,j-1)=255
  92.           PSET i,j,46
  93.         ENDIF
  94.       ENDIF
  95.     NEXT j
  96.   NEXT i
  97.   FOR i=96 TO 224                                 ! L'interieur du logo.
  98.     FOR j=49 TO 75
  99.       IF PTST(i,j)=255
  100.         PSET i,j,32-(j-49)
  101.       ENDIF
  102.     NEXT j
  103.   NEXT i
  104.   '
  105.   DEFFILL 0,2,8
  106.   PBOX 0,0,319,10                                 ! Efface ligne en haut.
  107.   PBOX 0,190,319,239                              ! Et en bas.
  108.   '
  109.   COLOR 255
  110.   PRINT AT(12,1);"F A L C O N  030 !"
  111.   BMOVE &HFFFF9800,buffer%,1024
  112.   BSAVE "\WORMHOLE\WORMHOLE.PI9",buffer%,77824
  113. ELSE
  114.   BLOAD "\WORMHOLE\WORMHOLE.PI9",buffer%
  115.   BMOVE buffer%,&HFFFF9800,1024
  116. ENDIF
  117. '
  118. GET 50,0,250,7,ass$
  119. DEFFILL 0,2,8
  120. PBOX 50,0,250,8
  121. ' **** Boucle principale ****
  122. REPEAT
  123.   VSYNC                                           ! Synchro avec l'écran.
  124.   ' *--- Rotation des couleurs ---*
  125.   INC tm&
  126.   IF tm&>2
  127.     c%={&HFFFF98C8}                               ! Sauve couleur 50.
  128.     BMOVE &HFFFF98B8,&HFFFF98BC,20                ! Décale 46/49 -> 47/50.
  129.     {&HFFFF98B8}=c%                               ! Couleur 46 = ancienne 50.
  130.     tm&=1
  131.   ENDIF
  132.   ' *--- Affichage 'FALCON 030' ---*
  133.   ADD ax&,av&                                     ! Déplacement du texte,
  134.   IF ax&<50
  135.     INC av&
  136.   ELSE
  137.     DEC av&
  138.   ENDIF
  139.   PUT ax&,0,ass$                                  ! Affiche le texte en haut.
  140.   ' *--- Défilement du texte ---*
  141.   RC_COPY image%,2,191,318,8 TO image%,0,191      ! Décale texte de 2 pixels.
  142.   IF d&=4                                         ! Si 4 décalages (8pixels).
  143.     DO                                            ! Caractère suivant.
  144.       at$=MID$(scr$,linep&,1)                     ! Prends caractère.
  145.       INC linep&                                  ! Caractère +1.
  146.       IF linep&>LEN(scr$)                         ! Si fin de la ligne.
  147.         linep&=1                                  ! 1er caractère.
  148.         INC linen&                                ! Ligne suivante.
  149.         IF linen&>2                               ! Nbr lignes de DATA (ici 2).
  150.           linen&=1                                ! Retour 1ere ligne.
  151.           RESTORE                                 ! Restaure les DATA.
  152.         ENDIF
  153.         READ scr$                                 ! Lit la ligne.
  154.       ENDIF
  155.       IF at$="*"                                  ! Si caractère= '*'
  156.         clr&=46                                   ! couleur = 46.
  157.       ENDIF
  158.       IF at$="@"
  159.         clr&=47
  160.       ENDIF
  161.       IF at$="#"
  162.         clr&=48
  163.       ENDIF
  164.       IF at$="$"
  165.         clr&=49
  166.       ENDIF
  167.       IF at$="%"
  168.         clr&=50
  169.       ENDIF
  170.       IF at$="^"
  171.         clr&=12
  172.       ENDIF
  173.       IF at$="&"
  174.         clr&=1
  175.       ENDIF
  176.     LOOP WHILE INSTR("*@#$%^&",at$)>0
  177.     DEFTEXT clr&,0,0,6                            ! Définit la couleur.
  178.     TEXT 311,197,at$                              ! Affiche le caractère.
  179.     d&=1                                          ! Décalage à 1.
  180.   ELSE
  181.     INC d&                                        ! Incrémente décalage.
  182.   ENDIF
  183. UNTIL BYTE{&HFFFFFC02}=57                         ! Test appui sur ESPACE
  184. @fin                                              ! Fini.
  185. ' *---  Procédure de modification des couleurs ---*
  186. PROCEDURE def_color(t&,r&,v&,b&)
  187.   r$=STRING$(2-LEN(HEX$(r&)),"0")+HEX$(r&)            ! Valeur Rouge.
  188.   v$=STRING$(2-LEN(HEX$(v&)),"0")+HEX$(v&)            ! Valeur Vert.
  189.   b$=STRING$(2-LEN(HEX$(b&)),"0")+HEX$(b&)            ! Valeur Bleu.
  190.   {ADD(&HFFFF9800,MUL(t&,4))}=VAL("&h"+r$+v$+"00"+b$) ! Modifie la couleur.
  191. RETURN
  192. ' *--- Tracé d'un cercle ---*
  193. PROCEDURE cercle(posx&,posy&,rayon&,coul&)
  194.   DEFFILL coul&,2,8                               ! Definit la couleur.
  195.   old_x%=0
  196.   old_y%=0
  197.   FOR angle&=0 TO 360                             ! 360 degrés.
  198.     x%=posx&+rayon&*SINQ(angle&)
  199.     y%=posy&+rayon&*COSQ(angle&)
  200.     IF old_x%<>0 AND old_y%<>0
  201.       PBOX old_x%,old_y%,x%,y%
  202.     ENDIF
  203.     old_x%=x%
  204.     old_y%=y%
  205.   NEXT angle&
  206. RETURN
  207. ' *--- Fin du programme ---*
  208. PROCEDURE fin
  209.   OUT 4,8                                           ! Réactive la souris.
  210.   ~XBIOS(5,L:sauve_ecr%,L:sauve_ecr%,3,resol&)      ! Anciens résol. / écrans.
  211.   ~MFREE(buffer%)                                   ! Libère la mémoire.
  212.   BYTE{&H484}=key|                                  ! Restaure le clavier.
  213.   ~GEMDOS(32,L:super%)                              ! Mode utilisateur.
  214.   END
  215. RETURN
  216. ' *--- Le texte à faire défiler ---*
  217. DATA "  *H@e#l$l*o@,# $p*e@o#p$l*e$!  &C'est moi, ^Fantomas&. Voici une petite demo pour *D@O#M$P*U@B# *0@3#0. &Encore quelques ^bugs &et ^améliorations &possibles, mais ca marche..."
  218. DATA " abcdefghij ............."
  219.