lockdown projects (sprite mouse image editor)

GFA BASIC-related articles in here please

Moderators: simonsunnyboy, Mug UK, Zorro 2, Moderator Team

Post Reply
User avatar
charles
10 GOTO 10
10 GOTO 10
Posts: 2844
Joined: Tue Aug 17, 2004 12:11 am
Location: ont. Canada
Contact:

lockdown projects (sprite mouse image editor)

Post by charles »

well ive been very isolated and with the pandemonious feeling slowily decreasing
had time to take on the task of figure out some graphic routines never fully understood .

so I rewrote a gfa basicv2 sprite/mouse/image editor into gfa v3.6tt syntax
would like to add some more features
now that's its current please write with some practical features I should include.

Code: Select all

' sof
'
' ============================================================================
' Update Source
KILL "b:\spr_edr3.lst"
LIST "b:\spr_edr3.lst"
'
' ============================================================================
' Main
@main
'
' ============================================================================
' Found The End
END
'
' ============================================================================
' Enter Main Program
PROCEDURE main
  LOCAL i&,mx&,my&,mk&
  '
  IF BTST(XBIOS(4),1)
    ' global variables
    '
    ' disk
    a$=""
    b$=""
    ' xy
    x_hotspot&=0
    y_hotspot&=0
    ' grfx
    DIM fore_grd&(15),back_grd&(15)
    '
    ' draw scrn
    @build_screen
    '
    ' main
    escape_flag!=FALSE
    ON MENU KEY GOSUB keyboard
    REPEAT
      ON MENU
      MOUSE mx&,my&,mk&
      IF mk&
        @mouse(mx&,my&,mk&)
      ENDIF
    UNTIL escape_flag!
    '
    GRAPHMODE 1
    COLOR 1
    DEFLINE 1,0,0,0
    FOR i&=0 TO 400 STEP 2
      BOX i&,i&,SUB(639,i&),SUB(399,i&)
      CIRCLE 320,200,SUB(375,i&)
    NEXT i&
    '
    DEFFILL 0,2,8
    PBOX 0,0,639,399
    '
  ELSE
    ALERT 3,"Sprite-Editor only| operate under| monochrome",1,"Oppps!",dummy%
  ENDIF
  '
RETURN
'
' ============================================================================
' Screen Image
PROCEDURE build_screen
  LOCAL i&,a&
  '
  GRAPHMODE 1
  '
  DEFLINE 1,1,0,0
  '
  DEFFILL 1,2,4
  PBOX 0,0,639,399
  '
  DEFFILL 1,2,8
  PRBOX 15,35,310,45
  PRBOX 35,75,615,290
  PRBOX 55,305,595,395
  '
  DEFFILL 1,0,8
  PRBOX 10,10,315,40
  PRBOX 30,70,620,285
  PRBOX 50,300,600,390
  PRBOX 440,100,600,260
  PRBOX 450,110,515,250
  '
  DEFFILL 1,2,8
  PRBOX 525,110,590,250
  '
  DEFLINE 1,1,0,0
  FOR i&=0 TO 16
    a&=MUL(i&,10)
    LINE 50,ADD(100,a&),210,ADD(100,a&)
    LINE 250,ADD(100,a&),410,ADD(100,a&)
    LINE ADD(50,a&),100,ADD(50,a&),260
    LINE ADD(250,a&),100,ADD(250,a&),260
  NEXT i&
  '
  DEFLINE 1,3,0,0
  LINE 30,270,620,270
  LINE 50,370,600,370
  '
  DEFTEXT 1,0,0,13
  TEXT 21,27,"Mouse & Sprite Image Editor for GFA"
  DEFTEXT 1,4,0,6
  TEXT 21,37,"Copyright 1986   GFA Systemtechnik "
  '
  DEFTEXT 1,0,0,4
  TEXT 50,280,550,"Please Write  :  Arnfried Griesert, Montanusstr. 8, 5653 Leichlingen"
  '
  DEFTEXT 1,1,0,13
  TEXT 50,90,"Foreground"
  TEXT 250,90,"Background"
  TEXT 440,90,"Sprite Render"
  '
  DEFTEXT 1,0,0,13
  TEXT 72,316,"F1 = Load Sprite"
  TEXT 72,338,"F2 = Save as Editor-File"
  TEXT 72,360,"F3 = Save as Sprite-File"
  TEXT 370,316,"F4 = Save as Mouse-File"
  TEXT 370,338,"F5 = Erase Sprite"
  TEXT 362,360,"F10 = Quit"
  '
  @hot_xy_loc(x_hotspot&,y_hotspot&)
  TEXT 87,386," = XY Hotspot"
  @hot_spot(x_hotspot&,y_hotspot&)
  '
  DEFTEXT 1,0,0,4
  TEXT 400,383,"Re-written 2021 Charles Copp"
RETURN
'
' ============================================================================
' KEYBOARD On Menu Interupt
PROCEDURE keyboard
  LOCAL item&
  item&=MENU(14)
  '  PRINT AT(2,2);USING "#####",item& MOD 255
  SELECT item&
  CASE 15104
    @sprite_load("SHP")
  CASE 15360
    @sprite_save("SHP")
  CASE 15616
    @spr_list("LST")
  CASE 15872
    @mos_list("LST")
  CASE 16128
    @reset
  CASE 283,17408
    @escape(item&)
  CASE 18432,19712,20480,19200
    @arrow_buts(item&)
  ENDSELECT
RETURN
'
' ============================================================================
PROCEDURE arrow_buts(z&)
  LOCAL x&,y&
  x&=x_hotspot&
  y&=y_hotspot&
  SELECT z&
  CASE 18432 !up
    y_hotspot&=MOD(ADD(y_hotspot&,15),16)
  CASE 19200 !left
    x_hotspot&=MOD(ADD(x_hotspot&,15),16)
  CASE 19712 !right
    x_hotspot&=MOD(ADD(x_hotspot&,1),16)
  CASE 20480 !down
    y_hotspot&=MOD(ADD(y_hotspot&,1),16)
  ENDSELECT
  @hot_xy_loc(x_hotspot&,y_hotspot&)
  @draw_sprite(x&,y&,SUB(15,x&))
  @hot_spot(x_hotspot&,y_hotspot&)
RETURN
PROCEDURE escape(a&)
  ALERT 2,"|Have you saved |your work?",1,"Yes|No",a&
  escape_flag!=(SUB(a&,2))
RETURN
'
' ============================================================================
' Sprite To All 3 Windows
PROCEDURE draw_sprite(x&,y&,a&)
  LOCAL b&,c&
  '
  b&=MUL(x&,10)
  c&=MUL(y&,10)
  ADD b&,50
  ADD c&,100
  '
  GRAPHMODE 1
  IF BTST(fore_grd&(y&),a&)=FALSE
    IF BTST(back_grd&(y&),a&)=FALSE
      DEFFILL 0,2,8
      PBOX ADD(b&,1),ADD(c&,1),ADD(b&,9),ADD(c&,9)
      PBOX ADD(201,b&),ADD(c&,1),ADD(209,b&),ADD(c&,9)
      PSET ADD(555,x&),ADD(172,y&),1
    ELSE
      DEFFILL 1,2,2
      PBOX b&,c&,ADD(b&,10),ADD(c&,10)
      PBOX ADD(200,b&),c&,ADD(210,b&),ADD(c&,10)
      PSET ADD(555,x&),ADD(172,y&),0
    ENDIF
    PSET ADD(475,x&),ADD(172,y&),0
  ELSE
    IF BTST(back_grd&(y&),a&)=FALSE
      DEFFILL 1,2,8
      PBOX b&,c&,ADD(b&,10),ADD(c&,10)
      PBOX ADD(200,b&),c&,ADD(210,b&),ADD(c&,10)
      PSET ADD(555,x&),ADD(172,y&),1
    ELSE
      DEFFILL 1,2,8
      PBOX b&,c&,ADD(b&,10),ADD(c&,10)
      DEFFILL 1,2,2
      PBOX ADD(200,b&),c&,ADD(210,b&),ADD(c&,10)
      PSET ADD(555,x&),ADD(172,y&),0
    ENDIF
    PSET ADD(475,x&),ADD(172,y&),1
    PSET ADD(555,x&),ADD(172,y&),1
  ENDIF
  '
  IF x&=x_hotspot& AND y&=y_hotspot&
    @hot_spot(x_hotspot&,y_hotspot&)
  ENDIF
  '
RETURN
'
' ============================================================================
' XY "HOTSPOT" Indicator
PROCEDURE hot_spot(x&,y&)
  LOCAL i&,a&,b&
  a&=MUL(x&,10)
  b&=ADD(MUL(y&,10),103)
  GRAPHMODE 3
  DEFLINE 1,0,0,0
  DEFFILL 1,2,8
  FOR i&=0 TO 4
    LINE ADD(53,a&),ADD(i&,b&),ADD(57,a&),ADD(i&,b&)
    PBOX ADD(253,a&),ADD(i&,b&),ADD(257,a&),ADD(i&,b&)
  NEXT i&
RETURN
PROCEDURE hot_xy_loc(x&,y&)
  LOCAL a$
  GRAPHMODE 1
  DEFTEXT 1,0,0,13
  a$="  "
  MID$(a$,1)=STR$(ADD(x&,1))
  TEXT 57,386,a$
  a$="  "
  MID$(a$,1)=STR$(ADD(y&,1))
  TEXT 78,386,a$
RETURN
'
' ============================================================================
' Load in *.SHP-File (F1)
PROCEDURE sprite_load(ext$)
  LOCAL i&,x&,y&,fore_grd%,back_grd%,dummy&
  '
  FILESELECT "\*."+ext$,b$,a$
  '
  IF LEN(a$)>1 THEN
    IF EXIST(a$) THEN
      b$=RIGHT$(a$,SUB(LEN(a$),1))
      '
      @draw_sprite(x_hotspot&,y_hotspot&,SUB(15,x_hotspot&))
      '
      OPEN "I",#1,a$
      INPUT #1,x_hotspot&,y_hotspot&
      FOR i&=0 TO 15
        INPUT #1,fore_grd%,back_grd%
        CARD{V:fore_grd&(i&)}=fore_grd%
        CARD{V:back_grd&(i&)}=back_grd%
      NEXT i&
      CLOSE #1
      '
      @hot_xy_loc(x_hotspot&,y_hotspot&)
      '
      FOR y&=0 TO 15
        FOR x&=0 TO 15
          @draw_sprite(x&,y&,SUB(15,x&))
        NEXT x&
      NEXT y&
      '
    ELSE
      ALERT 1,"File Doesn't Exist!",1,"Resume",dummy&
    ENDIF
  ENDIF
RETURN
'
' ============================================================================
' Save As *.SHP-File (F2)
PROCEDURE sprite_save(ext$)
  LOCAL i&
  '
  FILESELECT "\*."+ext$,b$,a$
  '
  IF LEN(a$)>1 THEN
    b$=RIGHT$(a$,SUB(LEN(a$),1))
    OPEN "O",#1,a$
    PRINT #1;x_hotspot&
    PRINT #1;y_hotspot&
    FOR i&=0 TO 15
      PRINT #1;CARD{V:fore_grd&(i&)}
      PRINT #1;CARD{V:back_grd&(i&)}
    NEXT i&
    CLOSE #1
  ENDIF
RETURN
'
' ============================================================================
' Save As Basic-Listing (Sprite.LST) (F3)
PROCEDURE sp_list(ext$)
  LOCAL i&,dummy%,shape$
  '
  '  @disk_op(shape$)
  '  PROCEDURE disk_op(VAR shape$)
  '
  FILESELECT "\*."+ext$,b$,a$
  '
  IF LEN(a$)>1 THEN
    shape$=a$
    WHILE INSTR(shape$,"\")<>0
      dummy%=SUB(LEN(shape$),INSTR(shape$,"\"))
      shape$=RIGHT$(shape$,dummy%)
    WEND
    '
    dummy%=INSTR(shape$,".")
    IF dummy%<>0 THEN
      shape$=LEFT$(shape$,SUB(dummy%,1))
    ELSE
      a$=a$+"."+ext$
    ENDIF
    b$=RIGHT$(a$,SUB(LEN(a$),1))
    '
    OPEN "O",#1,a$
    PRINT #1;"KILL ";CHR$(34);"B:\";shape$;".LST";CHR$(34)
    PRINT #1;"LIST ";CHR$(34);"B:\";shape$;".LST";CHR$(34)
    PRINT #1;"' Sprite-Data in String format "
    PRINT #1;shape$;"$";"=SPACE$(74)"
    PRINT #1;"MID$(";shape$;"$,1,10)=MKI$("+STR$(x_hotspot&)+")+MKI$("+STR$(y_hotspot&)+")+MKI$(0)+MKI$(0)+MKI$(1)"
    PRINT #1;"RESTORE";shape$
    PRINT #1;"FOR i&=0 TO 15"
    PRINT #1;"READ fore_grd%,back_grd%"
    PRINT #1;"MID$(";shape$;"$,ADD(11,(MUL(i&,4))),4)=MKI$(back_grd%)+MKI$(fore_grd%)"
    PRINT #1;"NEXT i&"
    PRINT #1;"'"
    PRINT #1;"SPRITE ";shape$;"$";",30,50"
    PRINT #1;"~INP(2)"
    PRINT #1;"'"
    PRINT #1;shape$;":"
    FOR i&=0 TO 15
      IF i&=8 OR i&=0
        PRINT #1
        PRINT #1;"DATA ";
      ELSE
        PRINT #1;",";
      ENDIF
      PRINT #1;STR$(CARD{V:fore_grd&(i&)});",";STR$(CARD{V:back_grd&(i&)});
    NEXT i&
    PRINT #1
    '
    CLOSE #1
  ENDIF
RETURN
'
' ============================================================================
' Save As Basic-Listing (Mouse.LST) (F4)
PROCEDURE mos_list(ext$)
  LOCAL i&,dummy%,a$,b$,shape$
  '
  FILESELECT "\*."+ext$,b$,a$
  '
  IF LEN(a$)>1 THEN
    shape$=a$
    WHILE INSTR(shape$,"\")<>0
      dummy%=SUB(LEN(shape$),INSTR(shape$,"\"))
      shape$=RIGHT$(shape$,dummy%)
    WEND
    dummy%=INSTR(shape$,".")
    IF dummy%<>0 THEN
      shape$=LEFT$(shape$,SUB(dummy%,1))
    ELSE
      a$=a$+"."+ext$
    ENDIF
    b$=RIGHT$(a$,SUB(LEN(a$),1))
    '
    OPEN "O",#1,a$
    PRINT #1;"KILL ";CHR$(34);"B:\";shape$;".LST";CHR$(34)
    PRINT #1;"LIST ";CHR$(34);"B:\";shape$;".LST";CHR$(34)
    PRINT #1;"' Mouse-Data in String Format"
    PRINT #1;shape$;"$";"=SPACE$(74)"
    PRINT #1;"MID$(";shape$;"$,1,10)=MKI$("+STR$(x_hotspot&)+")+MKI$("+STR$(y_hotspot&)+")+MKI$(1)+MKI$(0)+MKI$(1)"
    PRINT #1;"RESTORE ";shape$
    PRINT #1;"FOR i&=0 TO 31"
    PRINT #1;"READ a%"
    PRINT #1;"MID$(";shape$;"$,ADD(11,(MUL(i&,2))),2)=MKI$(a%)"
    PRINT #1;"NEXT i&"
    PRINT #1;"'"
    PRINT #1;"DEFMOUSE ";shape$;"$"
    PRINT #1;"~INP(2)"
    PRINT #1;"END"
    PRINT #1;"'"
    PRINT #1;shape$;":"
    FOR i&=0 TO 15
      IF i&=0 OR i&=8
        PRINT #1
        PRINT #1;"DATA ";
      ELSE
        PRINT #1;",";
      ENDIF
      PRINT #1;STR$(CARD{V:back_grd&(i&)});
    NEXT i&
    FOR i&=0 TO 15
      IF i&=0 OR i&=8
        PRINT #1
        PRINT #1;"DATA ";
      ELSE
        PRINT #1;",";
      ENDIF
      PRINT #1;STR$(CARD{V:fore_grd&(i&)});
    NEXT i&
    PRINT #1
    CLOSE #1
  ENDIF
RETURN
'
' ============================================================================
' Clear (Fore/Back Ground) (F5)
PROCEDURE reset
  LOCAL x&,y&
  ALERT 2,"!!WARNING!! |Sprite Data |Will be lost",2,"Clear|Leave",x&
  IF x&=1 THEN
    HIDEM
    ARRAYFILL fore_grd&(),0
    ARRAYFILL back_grd&(),0
    FOR y&=0 TO 15
      FOR x&=0 TO 15
        @draw_sprite(x&,y&,SUB(15,x&))
      NEXT x&
    NEXT y&
    SHOWM
  ENDIF
RETURN
'
' ============================================================================
' Handle Mouse Input
PROCEDURE mouse(x&,y&,k&)
  IF y&>99 AND y&<259
    IF x&>49 AND x&<209
      SUB x&,50
      DIV x&,10
      SUB y&,100
      DIV y&,10
      @mouse_1(V:fore_grd&(y&),x&,y&,k&)
    ELSE IF x&>249 AND x&<409
      SUB x&,250
      DIV x&,10
      SUB y&,100
      DIV y&,10
      @mouse_1(V:back_grd&(y&),x&,y&,k&)
    ENDIF
  ENDIF
  '
RETURN
PROCEDURE mouse_1(adr%,x&,y&,k&)
  LOCAL a&,b&
  a&=SUB(15,x&)
  CARD{V:b&}=CARD{adr%}
  IF k&=1 AND BTST(b&,a&)=FALSE
    CARD{adr%}=BSET(b&,a&)
  ELSE IF k&=2 AND BTST(b&,a&)
    CARD{adr%}=BCLR(b&,a&)
  ENDIF
  @draw_sprite(x&,y&,a&)
RETURN
'
REM ##########################################################################
REM ####                You have hardly reached the END                   ####
REM ##########################################################################
'
' eof

The radioactive half-life : )
Atari is a lifestyle,not a hobby.
HOLD ON ! ! ! Im printing unreadable characters ...!
Post Reply

Return to “GFA BASIC”