jargon

"Roe" Graphic Put routines

Mar 28th, 2021
465
Never
Not a member of Pastebin yet? Sign Up, it unlocks many cool features!
  1.  
  2. Const NULL As Any Ptr = 0
  3.  
  4. declare Function bmp_load( ByRef filename As Const String ) As Any Ptr
  5.  
  6. declare sub graphic_settings(filename as string=".\roe config\graphics.cfg")
  7.  
  8. declare SUB graphicput overload (xx1_short as short=0, yy1_short as short=0, ss1_string as string="")
  9.  
  10. declare SUB graphicput overload (path as string="sprites", layer as string="a", xx1_short as short=0, yy1_short as short=0, ss1_string as string="")
  11.  
  12. dim shared as short sprites_enabled=num_enabled
  13. dim shared as short fonts_enabled=num_enabled
  14. dim shared as short textcolor_enabled=num_enabled
  15.  
  16. graphic_settings ".\roe config\graphics.cfg"
  17.  
  18. Function bmp_load( ByRef filename As Const String ) As Any Ptr
  19.  
  20.     Dim As Long filenum, bmpwidth, bmpheight
  21.     Dim As Any Ptr img
  22.  
  23. '' open BMP file   
  24.     filenum = FreeFile()
  25.  
  26.     If Not(Open( filename For Binary Access Read As #filenum ) = 0 ) Then
  27.         Return NULL
  28.     End If
  29.    
  30. '' retrieve BMP dimensions
  31.     Get #filenum, 19, bmpwidth
  32.     Get #filenum, 23, bmpheight
  33.  
  34.     Close #filenum
  35.  
  36. '' create image with BMP dimensions
  37.     img = ImageCreate( bmpwidth, Abs(bmpheight) )
  38.  
  39.     If img = NULL Then
  40.         Return NULL
  41.     End If
  42.  
  43. '' load BMP file into image buffer
  44.     If Not( BLoad( filename, img ) = 0 ) Then
  45.         ImageDestroy( img )
  46.         Return NULL
  47.     End If
  48.    
  49.     Return img
  50.  
  51. End Function
  52.  
  53.  
  54. sub graphic_settings(filename as string=".\roe config\graphics.cfg")
  55.    
  56.     dim as long index=0
  57.     redim as string lines(any),parts(any),prefix(any),suffix(any)
  58.     dim as string buffer
  59.     fastload filename, buffer
  60.    
  61.     if len(buffer)=0 then exit sub
  62.    
  63.     trk_tok buffer,crlf,lines()
  64.     for index=1 to ubound(lines,1)
  65.         trk_tok lines(t),colon,parts()
  66.         trk_tok parts(1),underscore,prefix()
  67.         trk_tok parts(2),comma,suffix()
  68.         select case lcase(prefix(1))
  69.         case "graphics"
  70.             select case lcase(prefix(2))
  71.             case "sprites"
  72.                 select case lcase(suffix(1))
  73.                 case cfg_enabled
  74.                     sprites_enabled=num_enabled
  75.                 case cfg_disabled
  76.                     sprites_enabled=num_disabled
  77.                 end select
  78.             case "fonts"
  79.                 select case lcase(suffix(1))
  80.                 case cfg_enabled
  81.                     fonts_enabled=num_enabled
  82.                 case cfg_disabled
  83.                     fonts_enabled=num_disabled
  84.                 end select
  85.             case "textcolor"
  86.                 select case lcase(suffix(1))
  87.                 case cfg_enabled
  88.                     textcolor_enabled=num_enabled
  89.                 case cfg_disabled
  90.                     textcolor_enabled=num_disabled
  91.                 end select
  92.             end select
  93.         end select
  94.     next index
  95.    
  96. end sub
  97.  
  98. SUB graphicput overload (xx1_short as short=0, yy1_short as short=0, ss1_string as string="")  
  99.     graphicput "sprites", "a", xx1_short, yy1_short, ss1_string
  100.     graphicput "sprites", "o", xx1_short, yy1_short, ss1_string
  101. end sub
  102.  
  103. SUB graphicput overload (path as string="sprites", xx1_short as short=0, yy1_short as short=0, ss1_string as string="")
  104.    
  105.     select case lcase(path)
  106.     case "sprites":    
  107.         select case sprites_enabled
  108.         case num_enabled:
  109.             graphicput path, "a", xx1_short, yy1_short, ss1_string
  110.             graphicput path, "o", xx1_short, yy1_short, ss1_string
  111.         case num_disabled:
  112.             graphicput "sprites", "f", xx1_short, yy1_short, ss1_string
  113.         end select
  114.     case "fonts":
  115.         select case fonts_enabled
  116.         case num_enabled:
  117.             graphicput path, "a", xx1_short, yy1_short, ss1_string
  118.         case num_disabled:
  119.             graphicput "fonts", "f", xx1_short, yy1_short, ss1_string
  120.         end select
  121.     end select
  122.    
  123. end sub
  124.  
  125. SUB graphicput overload (path as string="sprites", layer as string="a", xx1_short as short=0, yy1_short as short=0, ss1_string as string="")
  126.  
  127.     dim as string a_filename, o_filename
  128.     dim as short x, y
  129.    
  130.     x=(xx1_short - 1) * 8
  131.     y=(yy1_short - 1) * 8
  132.    
  133.     dim as string glyph
  134.     glyph=space(0)
  135.    
  136.     ss1_string=lcase(left(ss1_string,8))
  137.    
  138.     dim as any ptr a
  139.     dim as any ptr o
  140.    
  141.     select case lcase(path)
  142.     case "sprites":
  143.         select case lcase(layer)
  144.         case "a":
  145.             a_filename = ".\bitmaps\tiles\mask\" + ss1_string + ".bmp
  146.  
  147.             if fileexists(a_filename) then
  148.                 a = bmp_load( a_filename )
  149.                 Bload a_filename,a
  150.             end if
  151.             if Imageinfo ( @a, a_colspan, a_rowspan)=0 then
  152.                 PUT (x, y), @a, and
  153.                 imagedestroy @a
  154.             end if
  155.         case "o":
  156.             o_filename = ".\bitmaps\tiles\rgb\" + ss1_string + ".bmp"
  157.             if fileexists(o_filename) then
  158.                 o=bmp_load( o_filename )
  159.             end if
  160.             if Imageinfo ( @o, o_colspan, o_rowspan)=0 then
  161.                 PUT (x, y), @o, or
  162.                 imagedestroy @o
  163.             end if
  164.         case "f":
  165.            
  166.             select case textcolor_enabled
  167.             case num_enabled:
  168.                 color ScreenFg,ScreenBg
  169.             case num_disabled:
  170.                 color 15,0
  171.             end select
  172.            
  173.             LOCATE yy1_short, xx1_short
  174.             PRINT left(ss1_string,4);
  175.             LOCATE yy1_short+1, xx1_short
  176.             PRINT right(ss1_string,4);
  177.            
  178.         end select
  179.     case "fonts":
  180.         select case lcase(layer)
  181.         case "a":
  182.             a_filename = ".\bitmaps\fonts\rgb\" + ss1_string + ".bmp"
  183.             if fileexists(a_filename) then
  184.                 a=bmp_load( a_filename )
  185.             end if
  186.             if Imageinfo ( @a, a_colspan, a_rowspan)=0 then
  187.                 PUT (x, y), @a, and    
  188.                 imagedestroy @a
  189.             end if
  190.         case "o":
  191.             a_filename=space(0)
  192.             'line(x,y)-(x+7,y+7),sc_short,bf
  193.         case "f":
  194.        
  195.             select case textcolor_enabled
  196.             case num_enabled:
  197.                 color ScreenFg,ScreenBg
  198.             case num_disabled:
  199.                 color 15,0
  200.             end select
  201.                        
  202.             select case lcase(left(ss1_string,4))
  203.             case "lttr":
  204.                 LOCATE yy1_short, xx1_short
  205.                 glyph=chr(val(mid(ss1_string,5,3)))
  206.                 PRINT glyph;
  207.             end select
  208.         end select 
  209.     end select
  210.    
  211.     'IF not(LEN(ss1_string)=8) THEN
  212.     '   LOCATE yy1_short + 1, xx1_short + 1: PRINT ".";
  213.     'END IF
  214.    
  215. END SUB
  216.  
  217.  
  218. '=================
  219.  
  220.  
  221. C:\Data\Roe\graphicput.bas(51) warning 13(0): Function result was not explicitly set
  222. C:\Data\Roe\graphicput.bas() error 48: Undefined label, NULL
  223. C:\Data\Roe\graphicput.bas() error 48: Undefined label, IMG
  224.  
RAW Paste Data

Adblocker detected! Please consider disabling it...

We've detected AdBlock Plus or some other adblocking software preventing Pastebin.com from fully loading.

We don't have any obnoxious sound, or popup ads, we actively block these annoying types of ads!

Please add Pastebin.com to your ad blocker whitelist or disable your adblocking software.

×