Love and Letter-bots

Post your FreeBASIC source, examples, tips and tricks here. Please don’t post code without including an explanation.
Post Reply
Quark
Posts: 474
Joined: May 27, 2011 18:16
Location: Pennsylvania, U.S.
Contact:
Contact Quark

Love and Letter-bots

Post by Quark »

.
Update 12/10/14 I am adding a collection of mini-demos about using a mask in FB. It is called 'Power of the Mask' and is posted in a new message below the original one'. Hope you like it. Also, I replaced the 'Love and Letter-bots' code with the essentially the same code, but tweaked for better hearts beating :-)

CAUTION: while there is no problem with selecting/copying this code and pasting it in an editor and running it, there IS a problem with downloading the file as a file -- that trashes the mask data, and the program does not work. So, select, copy, paste only!

For a new project, I am offering two features that get along fairly well -- screen masks and letter-bots. Where is this project going? -- I am working on that :-)

In a recent Tips and Tricks post, I looked at the graphics magenta screen which acts as a mask for whatever image is underneath. But this is one of many masks that can jazz up a graphics display. If a coder creates an array pattern matching the screen, it is possible to refer to that pattern, without printing it directly, to get masked effects.

The letter-bots are the simplest bots I could think of. Each bot -- represented by some character -- acts independently to move about. Currently, the letter-bots move this way: continue in same direction if possible, but sometimes change, choose another direction, if possible, with equal chances if blocked. And if no move possible, then sit there twiddling non-existent thumbs.

It is interesting how the simple letter-bots show a different emergent behavior, when moving in groups, than it knows about. This hints at other physical systems, such as electrical flow, or heat-transfer, or weather patterns.

However, what I am offering here as a first chunk of code, is purely for fun -- Love and Letter-bots. I wouldn't mind seeing this at giant size on some night-time skyscraper somewhere. Please have a look.
.

Code: Select all

'================================================================================
' Love_And_Letter-bots.bas by Quark 12/2/14
' Using FreeBASIC Compiler - Version 1.00.0 (09-14-2014), for win32 (32bit)
' Use it freely, modify it freely and any responsibility is yours.
'================================================================================
' Purpose: One of a series of graphics demos using common FreeBasic commands.
' This one has letter-bots running around in a mask of an eternal pattern.
'============================================================================== 
#lang "fb"
#include "fbgfx.bi"
Using fb
'============================================================================== 
Declare Sub Init()
Declare Sub MoveBot(bot As Integer)
Declare Function RndRange(lo As Integer, hi As Integer) As Integer 
Declare Function Chance(lo As Integer, hi As Integer) As Integer
Declare Sub Comment(msg As String, clr As Integer)
'============================================================================== 
Randomize (Timer)
Windowtitle "Simple FB Graphics Demo Series:  MASK - LOVE AND LETTER-BOTS"
'set up screen
Const w= 800, h= 600
Screenres w, h, 8
'define rows and columns
Dim Shared As Integer rows = 75, cols = 100   
Width cols,rows
'general string variable
Dim Shared As String tStr
'two characters used for mask
Dim Shared As String * 1 maskbrush = Chr(177), drawbrush = Chr(219)
 'for centering mask 
Dim Shared As Integer roffset, coffset
'variables for mask array
Dim Shared As Integer maskrows, maskcols, row, col, numbots
'color variables
Dim Shared As Integer drawcolor, maskcolor, mazecolor, commentcolor, splatcolor, duo
'variable for controlling 'bot change of direction"; high num = more 'placid' 
Dim Shared As Integer changechance
'4 positions for bot movement
Dim Shared As Integer look(0 To 3, 1 To 2) 
Dim Shared As String * 1 compass(0 To 3) = {"N", "E", "S", "W"}
'variables for mask start point 
Dim Shared As Integer entryrow, entrycol
'number of bots-into-mask
Dim Shared As Integer printedbots
'user messages
Dim As String msg
Dim As Integer msgctl 'message flag
Dim Shared As Double start
'bot type
Type btype
  ch As String * 1 
  clr As UInteger 
  currow As Integer 
  curcol As Integer 
  curdirection As String * 1 
  alive As Integer 
End Type
'------------------------------------------------------------------------------ 
'read in the mask, get dimensions for array
Restore mask1
Read tStr
maskrows = 0: maskcols = Len(tStr) 
While tStr <> "enddata" 
  maskrows = maskrows + 1 
  Read tStr
Wend

Dim Shared As String mask(maskrows, maskcols)

'fill the mask array and find total bot positions
Restore mask1
For row As Integer = 1 To maskrows
  Read tStr
  For col As Integer = 1 To maskcols 
    mask(row, col) = Mid(tStr, col, 1)
    If mask(row,col) = drawbrush Then numbots += 1
  Next 
Next
'reduce bot numbers to given percent of available spaces
numbots = numbots * .67 'number of active bots
Dim As Integer rate = 22 'speed
'bots array
Dim Shared As btype b(numbots)
'------------------------------------------------------------------------------ 
Init() 'set up values and arrays for mask and bot movement
'------------------------------------------------------------------------------ 
'main loop - move bot around its 'world'
Do

  'SCREEN MESSAGE
  Select Case msgctl
  Case 0
    Comment("Letter-bots introduced one-by one into the mask...",14)
    Sleep 3500
    msgctl = 1
  Case 1
    Comment("Adding letterbots to fill 80% of space available",14)
    msgctl = 2
  Case 2
    If printedbots = numbots Then
      Comment("LAST LETTER-BOT has entered the screen -- letter-bot behavior changes",12)
      Sleep 3500
      msgctl = 3
    End If
  Case 3
    Comment("Dynamic equilibrium - letter-bots move into blank areas (low-pressure)",14)
    start = timer
    msgctl = 4
  Case 4
    If (Timer - start) > 25 Then 
      Comment("Emergent behavior: letter-bots, ignorant of balance, create a near-balanced system as a whole",14)
      msgctl = 5
      start = 0
    End If
  End Select

  For i As Integer = 1 To numbots 
    MoveBot(i) 'move a bot
    If (i Mod rate) = 0 Then Sleep 1 'user-change, larger mod num runs faster
  Next i ' numbots loop
 
Loop Until inkey = Chr(27) 
 '------------------------------------------------------------------------------ 
End 
'============================================================================== 
Sub Init()
'for centering mask 
roffset = (rows - maskrows + 1) \ 2 
coffset = (cols - maskcols + 1) \ 2  

'set up colors
drawcolor = 11: maskcolor = 10: mazecolor = 1: splatcolor = 14: commentcolor = 15 : duo = 0  

'bot default settings
For i As Integer = 1 To numbots 
  ''F' or 'B'
  b(i).ch = "F" :b(i).clr = 4
  If Chance(1,2) Then b(i).ch = "B" : b(i).clr = 12
  If duo < 2 And Chance(10, numbots) Then
    b(i).ch = "*"
    b(i).clr = splatcolor
    duo = duo + 1 
  End If
  b(i).curdirection = "N" 
  b(i).alive = 0
Next 
 
'critical num for controlling 'bot change of direction"; high num = more 'placid' 
changechance = Int(numbots / 5 + 10) 'try to make bot more calm for crowded conditions  

'4 ways bot can "look" 
look(0, 1) = -1 : look(0, 2) = 0  'N 
look(1, 1) = 0  : look(1, 2) = 1  'E 
look(2, 1) = 1  : look(2, 2) = 0  'S 
look(3, 1) = 0  : look(3, 2) = -1 'W 

'locate single start point in mask
For row As Integer = 1 To maskrows
  For col As Integer = 1 To maskcols 
    If mask(row,col) = drawbrush Then
      entryrow = row : entrycol = col
      Exit For, For
    End If
  Next 
Next

End Sub
'============================================================================== 
Sub MoveBot(bot As Integer)
  'PRINT BOTS ONE BY ONE TO ENTRYROW, ENTRYCOL
  If printedbots < numbots Then
    If Not b(bot).alive Then
      For index As Integer = 1 To numbots
        If index <> bot Then
          If b(index).currow = entryrow And b(index).curcol = entrycol Then
            'can't introduce new bot now
            Return
          End If
        End If
      Next
      mask(entryrow, entrycol) = b(bot).ch
      b(bot).alive = -1
      b(bot).currow = entryrow
      b(bot).curcol = entrycol
      Locate roffset + entryrow, coffset + entrycol
      Color b(bot).clr
      Print b(bot).ch;
      printedbots += 1
    End If
  End If
  
  'Improve bot action while keeping everything under the control of chance.
  'BUILD UP LIST OF POSSIBLE MOVES 
  Dim As String tmpturns, choice
  Dim As Integer turnlen, t1, t2
  tmpturns = "": choice = "" 
  For index As Integer = 0 To 3 
    row = b(bot).currow + look(index, 1)
    col = b(bot).curcol + look(index, 2) 
    If row > 0 And row <= maskrows And col > 0 And col <= maskcols Then 
      If mask(row, col) = drawbrush Then 
        tmpturns &= compass(index) 
      End If 
    End If 
  Next 
  turnlen = Len(tmpturns) 'number of choices

  'ACT ACCORDING TO POSSIBLE MOVES; BIAS TO CONTINUE PRESENT COURSE 
  Select Case turnlen 
    Case 0 
      'no move possible 
      choice = "" 
    Case 1 
      'make only available move 
      choice = tmpturns 
    Case 2 
      'handle choice of 2 
      t1 = Instr(tmpturns, b(bot).curdirection) 
      If t1 = 0 Then 
        choice = Mid(tmpturns, RndRange(1, 2), 1) 'even chance 
      Else 
        t2 = RndRange(1, changechance) 
        Select Case t2 
          Case 1 'chances low change direction 
            Do 
              choice = Mid(tmpturns, RndRange(1, 2), 1) 
            Loop Until choice <> b(bot).curdirection 
          Case Else 'chances high same direction 
            choice = Mid(tmpturns, t1, 1) 
        End Select 
      End If 
    Case 3 
      'handle choice of 3 
      t1 = Instr(tmpturns, b(bot).curdirection) 
      If t1 = 0 Then 
        choice = Mid(tmpturns, RndRange(1, 3), 1) 'equal chance of direction 
      Else 
        t2 = RndRange(1, changechance) 
        Select Case t2 
          Case 1 'chance low of different direction 
            Do 
              choice = Mid(tmpturns, RndRange(1, 3), 1) 
            Loop Until choice <> b(bot).curdirection 
          Case Else ' chance high for same direction 
            choice = Mid(tmpturns, t1, 1) 
        End Select 
      End If 
    Case 4
    'handle choice of 4
      t1 = Instr(tmpturns, b(bot).curdirection) 
      t2 = RndRange(1, changechance) 
      Select Case t2 
        Case 1 
          Do 
            choice = Mid(tmpturns, RndRange(1, 4), 1) 
          Loop Until choice <> b(bot).curdirection 
        Case Else 
          choice = Mid(tmpturns, t1, 1) 
      End Select 
  End Select 

  Select Case choice 
    Case "" 
    Case "N" 
      row = b(bot).currow + look(0, 1): col = b(bot).curcol + look(0, 2) 
    Case "E" 
      row = b(bot).currow + look(1, 1): col = b(bot).curcol + look(1, 2) 
    Case "S" 
      row = b(bot).currow + look(2, 1): col = b(bot).curcol + look(2, 2) 
    Case "W" 
      row = b(bot).currow + look(3, 1): col = b(bot).curcol + look(3, 2) 
  End Select 

  'UPDATE MASK ARRAY AND PRINT BOT
  If choice <> "" Then 
    mask(row, col) = b(bot).ch
    mask(b(bot).currow, b(bot).curcol) = drawbrush
    
    Locate roffset + row, coffset + col
    Color b(bot).clr
    Print b(bot).ch; 'new position
     
    Locate roffset + b(bot).currow, coffset + b(bot).curcol
    Print " "; 'delete old position
    
    b(bot).currow = row
    b(bot).curcol = col
    b(bot).curdirection = choice 
  End If 
End Sub
'============================================================================== 
Function RndRange(lo As Integer, hi As Integer) As Integer
  Dim r As Integer 
  r = hi - lo + 1 
  Return Int(Rnd(1) * (hi - lo + 1) + lo) 
End Function 
'================================================================================
Function Chance(lo As Integer, hi As Integer) As Integer
  'returns 1 if chance is successful, 0 otherwise 
  If lo >= hi Then Chance% = -1 
  Return Int(Rnd * hi) < lo 
End Function 
'==============================================================================
Sub Comment(msg As String, clr As Integer)
  Locate rows,1 : Print Space(cols-2); 
  Locate rows,(cols-Len(msg))\2 : Color clr : Print msg;
End Sub
'==============================================================================
mask1:
Data "±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±"
Data "±±±±±±±±±±±±±±±±±±±±±ÛÛÛÛÛÛÛÛÛÛÛÛ±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±ÛÛÛÛÛÛÛÛÛÛ±±±±±±±±±±±±±±±±±±±±±±±"
Data "±±±±±±±±±±±±±±±±±±ÛÛÛÛ±±±±±±±±±±ÛÛÛÛÛ±±±±±±±±±±±±±±±±±±±±±±±ÛÛÛÛÛÛÛÛ±±±±±±±±ÛÛÛÛ±±±±±±±±±±±±±±±±±±±±"
Data "±±±±±±±±±±±±±±±±±ÛÛ±±±±±±±±±±±±±±±±±ÛÛÛ±±±±±±±±±±±±±±±±±±±±ÛÛ±±±±±±±±±±±±±±±±±±ÛÛÛÛÛ±±±±±±±±±±±±±±±±"
Data "±±±±±±±±±±±±±±±ÛÛÛ±±±±±±±±±±±±±±±±±±±±ÛÛÛ±±±±±±±±±±±±±±±±±ÛÛ±±±±±±±±±±±±±±±±±±±±±±±ÛÛÛ±±±±±±±±±±±±±±"
Data "±±±±±±±±±±±±±±ÛÛ±±±±±±±±±±±±±±±±±±±±±±±±Û±±±±±±±±±±±±±±±±ÛÛ±±±±±±±±±±±±±±±±±±±±±±±±±±ÛÛÛ±±±±±±±±±±±±"
Data "±±±±±±±±±±±±±ÛÛ±±±±±±±±±±±±±±±±±±±±±±±±±ÛÛ±±±±±±±±±±±±±ÛÛÛ±±±±±±±±±±±±±±±±±±±±±±±±±±±±±Û±±±±±±±±±±±±"
Data "±±±±±±±±±±±±ÛÛ±±±±±±±±±±±±±±±±±±±±±±±±±±±ÛÛ±±±±±±±±±±±ÛÛ±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±ÛÛ±±±±±±±±±±±"
Data "±±±±±±±±±±±ÛÛ±±±±±±±±±±±±±±±±±±±±±±±±±±±±±ÛÛ±±±±±±±±±ÛÛ±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±ÛÛ±±±±±±±±±±"
Data "±±±±±±±±±ÛÛÛ±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±ÛÛ±±±±±±±ÛÛ±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±ÛÛ±±±±±±±±±"
Data "±±±±±±±±±Û±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±Û±±±±±±±Û±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±Û±±±±±±±±±"
Data "±±±±±±±±ÛÛ±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±ÛÛ±±±±±±Û±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±ÛÛ±±±±±±±±"
Data "±±±±±±±ÛÛ±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±Û±±±±±±Û±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±Û±±±±±±±±"
Data "±±±±±±±Û±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±Û±±±±±±Û±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±ÛÛ±±±±±±±"
Data "±±±±±±±Û±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±Û±±±±±±Û±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±Û±±±±±±±"
Data "±±±±±±ÛÛ±±±±±±±±±±±±±±±±±±±±±±±±±±ÛÛÛÛ±±±±±±±Û±±±±±±ÛÛÛÛ±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±ÛÛ±±±±±±"
Data "±±±±±±Û±±±±±±±±±±±±±±±±±±±±±±±±±ÛÛÛ±±ÛÛÛÛÛ±±±Û±±±±±±Û±±ÛÛ±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±Û±±±±±±"
Data "±±±±±±Û±±±±±±±±±±±±±±±±±±±±±±±±ÛÛ±±±±±±±±ÛÛÛ±Û±±±±±±Û±±±ÛÛÛ±ÛÛÛÛÛÛÛÛ±±±±±±±±±±±±±±±±±±±±±±±±±Û±±±±±±"
Data "±±±±±ÛÛ±±±±±±±±±±±±±±±±±±±±±±±ÛÛ±±±±±±±±±±±ÛÛÛ±±±±±±Û±±±±±ÛÛÛ±±±±±±ÛÛÛ±±±±±ÛÛÛÛ±±±±±±±±±±±±±±Û±±±±±±"
Data "±±±±±Û±±±±±±±±±±±±±±±±±±±±±±±±Û±±±±±±±±±±±±±ÛÛ±±±±±±Û±±±±±±±±±±±±±±±±Û±±±ÛÛÛ±±ÛÛ±±±±±±±±±±±±±Û±±±±±±"
Data "±±±±±Û±±±±±±±±±±±±±±±±±±±±±±±±Û±±±±±±±±±±±±±Û±±±±±±±Û±±±±±±±±±±±±±±±±Û±±±Û±±±±±Û±±±±±±±±±±±±±Û±±±±±±"
Data "±±±±ÛÛ±±±±±±±±±±±±±±±±±±±±±±±ÛÛ±±±±±±ÛÛ±±±±±Û±±±±±±±Û±±±±±Û±±±±±±±±±±Û±±ÛÛ±±±±±Û±±±±±±±±±±±±±Û±±±±±±"
Data "±±±±Û±±±±±±±±±±±±±±±±±±±±±±±±Û±±±±±±±±ÛÛ±±±ÛÛ±±±±±±±Û±±±±ÛÛ±±±±±±±±±±Û±±Û±±±±±±Û±±±±±±±±±±±±±Û±±±±±±"
Data "±±±ÛÛ±±±±±±±±±±±±±±±±±±±±±±±±Û±±±±±±±±±ÛÛÛÛÛÛ±±±±±±±ÛÛÛÛÛÛ±±±±±±±±±±±Û±±Û±±±±±±Û±±±±±±±±±±±±±Û±±±±±±"
Data "±±±Û±±±±±±±±±±±±±±±±±±±±±±±±±Û±±±±±±±±±±±±±±Û±±±±±±±Û±±±±±±±±±±±±±±±±Û±±Û±±±±±±Û±±±±±±±±±±±±±Û±±±±±±"
Data "±±±Û±±±±±±±±±±±±±±±±±±±±±±±±±Û±±±±±±±±±±±±±±Û±±±±±±±Û±±±±±±±±±±±±±±±±ÛÛÛÛ±±±±±±Û±±±±±±±±±±±±±Û±±±±±±"
Data "±±±Û±±±±±±±±±±±±±±±±±±±±±±±±±Û±±±±±±±±±±±±±±Û±±±±±±±Û±±±±±±±±±±±±±±±±±±±±±±±±±±Û±±±±±±±±±±±±ÛÛ±±±±±±"
Data "±±±Û±±±±±±±±±±±±±±±±±±±±±±±±±Û±±±±±±±±±±±±±±Û±±±±±±±Û±±±±±±±±±±±±±±±±±±±±±±±±±ÛÛÛÛ±±±±±±±±±±Û±±±±±±±"
Data "±±±Û±±±±±±±±±±±±±±±±±±±±±±±±ÛÛ±±±±±±±±±±±±±±Û±±±±±±±Û±±±±±±±±±±±±±±±±±±±±±Û±±ÛÛ±±ÛÛ±±±±±±±±ÛÛ±±±±±±±"
Data "±±±Û±±±±±±±±±±±±±±±±±±±±±±±±Û±±±±±±±±±±±±±±±Û±±±±±±±Û±±±±±±±±±±±±±±±±±±±±±ÛÛÛÛ±±±±ÛÛ±±±±±±±Û±±±±±±±±"
Data "±±±Û±±±±±±±±±±±±±±±±±±±±±±±±Û±±±±±±±±±±±±±±±Û±±±±±±±Û±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±ÛÛÛ±±±±±Û±±±±±±±±"
Data "±±±Û±±±±±±±±±±±±±±±±±±±±±±±±Û±±±±±±±±±±±±±±±Û±±±±±±±ÛÛ±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±ÛÛ±±±ÛÛ±±±±±±±±"
Data "±±±Û±±±±±±±±±±±±±±±±±±±±±±±±Û±±±±±±±±±±±±±±±Û±±±±±±±±Û±±±ÛÛÛ±±±±±±±±±±±±±±±±±±±±±±±±±±ÛÛ±±Û±±±±±±±±±"
Data "±±±Û±±±±±±±±±±±±±±±±±±±±±±±±Û±±±±±±±±±ÛÛÛ±±ÛÛ±±±±±±±±ÛÛ±ÛÛ±Û±±±±±±±±±±±±±±±±±±±±±±±±±±±ÛÛ±Û±±±±±±±±±"
Data "±±±Û±±±±±±±±±±±±±±±±±±±±±±±±Û±±±±±Û±±ÛÛ±ÛÛÛÛ±±±±±±±±±±ÛÛÛ±±ÛÛ±±±Û±±±±±±±±±±±±±±±±±±±±±±±ÛÛÛ±±±±±±±±±"
Data "±±±Û±±±±±±±±±±±±±±±±±±±±±±±±Û±±±±±ÛÛÛÛ±±±±±±±±±±±±±±±±±±±±±±Û±±ÛÛ±±±±±±±±±±±±±±±±±±±±±±±±±ÛÛÛ±±±±±±±"
Data "±±±ÛÛ±±±±±±±±±±±±±±±±±±±±±±ÛÛ±±±±±±ÛÛÛ±±±±±±±±±±±±±±±±±±±±±±Û±ÛÛ±±±±±±±±±±±±±±±±±±±±±±±±±±±±Û±±±±±±±"
Data "±±±±Û±±±±±±±±±±±±±±±±±±±±±±Û±±±±±±ÛÛ±ÛÛ±±±±±±±±±±±±±±±±±±±±±ÛÛÛ±±±±±±±±±±±±±±±±±±±±±±±±±±±±±ÛÛÛ±±±±±"
Data "±±±±Û±±±±±±±±±±±±±±±±±±±±±ÛÛ±±±±±ÛÛ±±±ÛÛ±±±±±±±±±±±±±±±±±±ÛÛÛ±ÛÛ±±±±±±±±ÛÛ±±±±±±±±±±±±±±±±±±±±Û±±±±±"
Data "±±±ÛÛ±±±±±±±±±±±±±±±±±±±±±Û±±±±±ÛÛ±±±±±ÛÛ±±±±±±±±±±±±±±±±ÛÛ±±±±ÛÛ±±±±ÛÛÛÛ±±±±±±±±±±±±±±±±±±±±±ÛÛÛ±±±"
Data "±±±Û±±±±±±±±±±±±±±±±±±±±±±Û±±±±ÛÛ±±±±±±±ÛÛ±±±±±±±±±±±±±ÛÛÛ±±±±±±ÛÛÛÛÛÛ±±±±±±±±±±±±±±±±±±±±±±±±±±Û±±±"
Data "±±ÛÛ±±±±±±±±±±±±±±±±±±±±±ÛÛ±ÛÛÛÛ±±±±±±±±±Û±±±±±±±±±±±±ÛÛ±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±ÛÛ±±"
Data "±ÛÛ±±±±±±±±±±±±±±±±±±±±±±Û±±±±±±±±±±±±±±±ÛÛ±±±±±±±±±±ÛÛ±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±ÛÛ±"
Data "±Û±±±±±±±±±±±±±±±±±±±±±±ÛÛ±±±±±±±±±±±±±±±±Û±±±±±±±±±ÛÛ±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±Û±"
Data "±Û±±±±±±±±±±±±±±±±±±±±±ÛÛ±±±±±±±±±±±±±±±±±ÛÛ±±±±±±±ÛÛ±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±Û±"
Data "±Û±±±±±±±±±±±±±±±±±±±±±Û±±±±±±±±±±±±±±±±±±±Û±±±±±±±Û±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±Û±"
Data "±Û±±±±±±±±±±±±±±±±±±±±ÛÛ±±±±±±±±±±±±±±±±±±±ÛÛ±±±±±ÛÛ±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±Û±"
Data "±Û±±±±±±±±±±±±±±±±±±ÛÛÛ±±±±±±±±±±±±±±±±±±±±±Û±±±±ÛÛ±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±Û±"
Data "±ÛÛÛ±±±±±±±±±±±±±ÛÛÛÛ±±±±±±±±±±±±±±±±±±±±±±±Û±±±ÛÛ±±±±±±±±±±±±±±±±±±±±±±±±±ÛÛÛÛ±±±±±±±±±±±±±±±±±±±Û±"
Data "±ÛÛÛÛÛ±±±±±±±±ÛÛÛÛ±±±±±±±±±±±±±±±±±±±±±±±±ÛÛÛÛÛÛÛÛÛÛÛÛ±±±±±±±±±±±±±±±±±±±±Û±Û±ÛÛÛÛ±±±±±±±±±±±±±±±±Û±"
Data "±Û±±±ÛÛÛÛÛÛÛÛÛÛ±±±±±±±±±±±±±±±±±±±±±±ÛÛÛÛÛÛ±Û±±ÛÛ±±±±ÛÛÛÛ±±±±±±±±±±ÛÛ±±±±ÛÛ±Û±Û±ÛÛÛ±±±±±±±±±±±±±±±Û±"
Data "±Û±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±ÛÛ±±±±±±Û±±Û±±±±±±±±ÛÛ±±±±±±±ÛÛÛÛÛÛ±±ÛÛ±Û±Û±ÛÛÛÛÛ±±±±±±±±±±±±±Û±"
Data "±Û±±±±±±±±±±±±±±ÛÛÛÛÛÛ±±±±±±±±±±±±±ÛÛ±±±±±±±ÛÛÛÛ±±±±±±±±±Û±±±±±ÛÛÛÛ±Û±Û±ÛÛÛ±Û±Û±Û±Û±Û±±±±±±±±±±±±±Û±"
Data "±Û±±±±±±±±±±±ÛÛÛÛÛ±Û±Û±±ÛÛÛÛÛ±±±±±±Û±±±±±±±±±ÛÛ±±±±±±±±±±ÛÛ±±±ÛÛÛ±Û±Û±ÛÛÛ±Û±Û±Û±Û±Û±ÛÛ±±±±±±±±±±±±Û±"
Data "±Û±±±±±±±±±ÛÛÛ±Û±Û±Û±ÛÛÛÛÛ±ÛÛÛ±±±±±Û±±±±±±±±±ÛÛ±±±±±±±±±±±Û±±±Û±Û±Û±Û±Û±Û±Û±Û±Û±Û±Û±ÛÛÛ±±±±±±±±±±±Û±"
Data "±Û±±±±±±±±±Û±Û±Û±Û±Û±Û±Û±Û±Û±ÛÛÛ±±±Û±±±±±±±±±ÛÛ±±±±±±±±±±ÛÛ±±±Û±Û±Û±Û±Û±Û±Û±Û±Û±Û±Û±Û±Û±±±±±±±±±±±Û±"
Data "±Û±±±±±±±ÛÛÛ±Û±Û±Û±Û±Û±Û±Û±Û±Û±Û±±±Û±±±±±±±±±±±±±±±±±±±±±Û±±±±Û±Û±Û±Û±Û±Û±Û±Û±Û±Û±Û±Û±Û±±±±±±±±±±±Û±"
Data "±Û±±±±±±±Û±Û±Û±Û±Û±Û±Û±Û±Û±Û±Û±Û±±±Û±±ÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛ±±±±Û±Û±Û±Û±Û±Û±Û±Û±Û±Û±Û±Û±Û±±±±±±±±±±±Û±"
Data "±Û±±±±±±±Û±Û±Û±Û±Û±Û±Û±Û±Û±Û±Û±Û±±±ÛÛ±Û±±±±±±±±±±±±±±±±±±Û±±±±Û±Û±Û±Û±Û±Û±Û±Û±Û±Û±Û±Û±Û±±±±±±±±±±±Û±"
Data "±Û±±±±±±±Û±Û±Û±Û±Û±Û±Û±Û±Û±Û±Û±Û±±±±Û±ÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛ±ÛÛ±±±±Û±Û±Û±Û±Û±Û±Û±Û±Û±Û±Û±Û±Û±±±±±±±±±±±Û±"
Data "±Û±±±±±±±Û±Û±Û±Û±Û±Û±Û±Û±Û±Û±Û±Û±±±±Û±±±±±±±±±±±±±±±±±Û±ÛÛÛ±±±Û±Û±Û±Û±Û±Û±Û±Û±Û±Û±Û±Û±Û±±±±±±±±±±±Û±"
Data "±Û±±±±±±±Û±Û±Û±Û±Û±Û±Û±Û±Û±Û±Û±Û±±±±Û±ÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛ±Û±Û±±±Û±Û±Û±Û±Û±Û±Û±Û±Û±Û±Û±Û±Û±±±±±±±±±±±Û±"
Data "±Û±±±±±±±Û±Û±Û±Û±Û±Û±Û±Û±Û±Û±Û±Û±±ÛÛÛ±Û±±±±±±±±±±±±±±±±±Û±Û±±±Û±±±Û±Û±Û±Û±Û±Û±Û±Û±Û±±±Û±±±±±±±±±±±Û±"
Data "±Û±±±±±±±Û±Û±Û±Û±Û±Û±Û±Û±Û±Û±±±Û±±Û±Û±ÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛ±±Û±ÛÛ±±ÛÛ±±Û±Û±Û±Û±Û±Û±Û±Û±Û±±ÛÛ±±±±±±±±±±±Û±"
Data "±Û±±±±±±±Û±±±Û±Û±Û±Û±Û±Û±Û±Û±±ÛÛ±ÛÛ±Û±±±±±±±±±±±±±±±±Û±±Û±±Û±±±ÛÛ±±±Û±Û±Û±Û±Û±Û±Û±±±ÛÛ±±±±±±±±±±±±Û±"
Data "±Û±±±±±±±ÛÛÛ±Û±Û±Û±Û±Û±Û±Û±±±ÛÛ±±Û±±Û±±ÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛ±ÛÛ±±ÛÛ±±±ÛÛ±±Û±Û±Û±Û±Û±Û±Û±ÛÛÛ±±±±±±±±±±±±±Û±"
Data "±Û±±±±±±±±±Û±±±Û±Û±Û±Û±Û±±±ÛÛÛ±±ÛÛ±±±Û±Û±±±±±±±±±±±±±±±Û±±±±Û±±±±ÛÛ±±±Û±Û±Û±Û±Û±±±ÛÛ±±±±±±±±±±±±±±Û±"
Data "±Û±±±±±±±±±ÛÛÛ±±±Û±Û±Û±±±±ÛÛ±±±±Û±±±±Û±ÛÛÛÛÛÛÛÛÛÛÛÛÛÛ±±Û±±±±ÛÛ±±±±ÛÛÛ±±±Û±Û±Û±Û±±ÛÛÛ±±±±±±±±±±±±±±Û±"
Data "±Û±±±±±±±±±±±ÛÛ±±±±±±±±±ÛÛÛ±±±±ÛÛ±±±±Û±±±±±±±±±±±±±±Û±±Û±±±±±Û±±±±±±ÛÛ±±±±±±±±±±ÛÛÛ±±±±±±±±±±±±±±±Û±"
Data "±Û±±±±±±±±±±±±ÛÛÛÛÛÛÛÛÛÛ±±±±±±±Û±±±±±ÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛ±ÛÛ±±±±±ÛÛ±±±±±±ÛÛÛÛÛÛÛÛÛÛÛÛ±±±±±±±±±±±±±±±±±Û±"
Data "±Û±±±±±±±±±±±±±±±±±Û±±±±±±±±±±ÛÛ±±±±±±Û±±±±±±±±±±±±±±±Û±±±±±±±ÛÛ±±±±±±±±±±Û±±±±±±±±±±±±±±±±±±±±±±±Û±"
Data "±ÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛ±±±±±±±ÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛ±±±±±±±±ÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛ±"
Data "±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±"
Data "enddata"
Last edited by Quark on Dec 10, 2014 8:43, edited 1 time in total.
Top
Quark
Posts: 474
Joined: May 27, 2011 18:16
Location: Pennsylvania, U.S.
Contact:
Contact Quark

Re: Love and Letter-bots

Post by Quark »

.
To further this little project along, I am adding a set of mini-demos called 'Power of the Mask' which illustrates some of what can be done with masks, besides the use of the magenta mask to provide transparency. It features the mysterious Quantum Moth, and a view of a sunrise by Aldous Huxley. Intrigued?
.

Code: Select all

'==============================================================================
' Power_of_the_Mask_Demo.bas by Quark 12/10/2014
' Using FreeBASIC Compiler - Version 1.00.0 (09-14-2014), for win32 (32bit)
' Use it freely, modify it freely and any responsibility is yours.
'==============================================================================
' Purpose: One of a series of graphics demos using common FreeBasic commands.
' This one features four mini mask demos.
'==============================================================================
#lang "fb"
#include "fbgfx.bi"
Using fb
'==============================================================================
'Declares
Declare Function RndRange(lo As Integer,hi As Integer) As Integer
Declare Function Chance(hap As Integer) As Integer
Declare Sub ViewComment(offset As Integer)
Declare Sub Polar2Cartesian (cpdist As Double, cpangle As Double)
Declare Sub MakeLine()
'==============================================================================
'INIT
Randomize Timer
Dim Shared As Integer w = 800, h = 600
Screenres w, h, 32
Windowtitle "Simple FB Graphics Demo Series - POWER OF THE MASK"
Dim Shared As Integer rows = 75, cols = 100
Const As UInteger BLACK = Rgb(&H00,&H00,&H00), WHITE = Rgb(&HFF,&HFF,&HFF)
Dim Shared As Integer row, col, cnt, tint, thetaplus, res 'utility vars
Dim Shared As UInteger curcolor, hue
Dim Shared As UInteger maskcolor = Rgb(&H00,&H08,&H20), drawcolor = Rgb(&H00,&HD0,&HF0)
Dim Shared As String tStr
Dim Shared As String * 1 ch, brush, maskbrush = Chr(177), drawbrush = Chr(219)
Dim Shared As Double cpx, cpy, cpangle, cpdist 'Polar2Cart
Dim Shared As Double radius, theta
Dim Shared As Integer maskrows = 73, maskcols = 100
ReDim As String mask(maskrows,maskcols)
'==============================================================================
' COMMENT SECTION
'------------------------------------------------------------------------------
Comment1:
Data ""
Data "                           POWER OF THE MASK"
Data ""
Data ""
Data "The graphics magenta mask is a good tool for graphics, but it is not"
Data "the only mask available in BASIC programming."
Data ""
Data ""
Data "When the screen is divided up into rows and columns, it is possible to"
Data "create a screen-array of characters -- one for each column position."
Data "These characters can act as a mask for printing to the screen, without"
Data "printing the mask itself.  For a simple two-character mask, the coder"
Data "refers to the mask array for a given row-column position to see if a"
Data "character should be printed there."
Data ""
Data ""
Data "And that is what is done in the first mini-demo which shows an example"
Data "of screen-printing which would be hard to do without the helpful mask."
Data ""
Data ""
Data ""
Data "                    Exit any mini-demo with <ESC>"
Data ""
Data ""
Data ""
Data ""
Data ""
Data ""
Data ""
Data ""
Data ""
Data ""
Data ""
Data "    ...any key to to view a mask-controlled printing to the screen..."
Data "enddata"
Restore Comment1
ViewComment(14) 'data-to-viewport commentary
'------------------------------------------------------------------------------
'CODE SECTION
'------------------------------------------------------------------------------
Screenres 800, 600, 32
rows = 75 : cols = 100
Width cols, rows
Windowtitle "Simple FB Graphics Demo Series - POWER OF THE MASK"
Color ,Rgb(&H00,&H08,&H10)
Cls

row = 0
Restore mask1
Read tStr
While tStr <> "enddata"
  row += 1
  For col As Integer = 1 To maskcols
    mask(row,col) = Mid(tStr,col,1)
  Next
  Read tStr
Wend

While inkey <> "" : Wend
cnt = 0
Do
  row = RndRange(1,maskrows) : col =  RndRange(1,maskcols)
  If mask(row,col) <> maskbrush Then
    Locate row,col
    Color Rgb(RndRange(1,8) * 32 - 1, RndRange(1,8) * 32 - 1, RndRange(1,8) * 32 - 1)
    Print "*";
    cnt += 1
    If cnt Mod 10 = 0 Then cnt = 0: Sleep 1
  End If
Loop Until inkey = Chr(27)
'==============================================================================
' COMMENT SECTION
'------------------------------------------------------------------------------
Comment2:
Data ""
Data "                           POWER OF THE MASK"
Data ""
Data ""
Data ""
Data ""
Data "The simple mask of two characters can be easily reversed.  Have a look."
Data ""
Data ""
Data ""
Data ""
Data ""
Data ""
Data ""
Data ""
Data ""
Data ""
Data ""
Data ""
Data ""
Data ""
Data ""
Data ""
Data "              ...any key to to view the mask reversed..."
Data "enddata"
Restore Comment2
ViewComment(14) 'data-to-viewport commentary
'------------------------------------------------------------------------------
'CODE SECTION
'------------------------------------------------------------------------------
Screenres 800, 600, 32
rows = 75 : cols = 100
Width cols, rows
Windowtitle "Simple FB Graphics Demo Series - POWER OF THE MASK"
Color ,Rgb(&H00,&H08,&H10)
Cls

While inkey <> "" : Wend
cnt = 0
Do
  row = RndRange(1,maskrows) : col =  RndRange(1,maskcols)
  If mask(row,col) = maskbrush Then
    Locate row,col
    Color Rgb(RndRange(1,8) * 32 - 1, RndRange(1,8) * 32 - 1, RndRange(1,8) * 32 - 1)
    Print "*";
    cnt += 1
    If cnt Mod 10 = 0 Then cnt = 0: Sleep 1
  End If
Loop Until inkey = Chr(27)

'==============================================================================
' COMMENT SECTION
'------------------------------------------------------------------------------
Comment3:
Data ""
Data "                           POWER OF THE MASK"
Data ""
Data "                     PORTRAIT BY THE QUANTUM MOTH"
Data ""
Data ""
Data ""
Data "While investigating the many possibilities of the mask, I stumbled on"
Data "the Quantum Moth, about which it is not wise to inquire too closely."
Data "But it was amused to flit about in a restrictive mask, as a change"
Data "from being without any restriction at all.  No accounting for taste."
Data ""
Data ""
Data "Anyway, it fit my desire to see what a single random agent would"
Data "accomplish as an artist working away within a mask.  I bet you are"
Data "curious too, so here is a portrait of me in my heftier days rendered"
Data "by (shudder) the Quantum Moth."
Data ""
Data ""
Data ""
Data ""
Data ""
Data ""
Data ""
Data ""
Data ""
Data ""
Data ""
Data ""
Data ""
Data "          ...any key to to view the Quantum Moth as artist..."
Data "enddata"
Restore Comment3
ViewComment(14) 'data-to-viewport commentary
'------------------------------------------------------------------------------
'CODE SECTION
'------------------------------------------------------------------------------
'set up screen
w = 800 : h = 624
Screenres w, h, 8
Windowtitle "Simple FB Graphics Demo Series - PORTRAIT BY THE QUANTUM MOTH"
rows = 39 : cols = 100
Width cols, rows
Color ,BLACK
Cls
'define rows and columns
maskrows = 37 : maskcols = 100
ReDim mask(maskrows, maskcols)
drawbrush=Chr(178) : maskbrush=Chr(219)

'read the text screen mask for moth
Restore mask2
For row As Integer = 1 To maskrows
  Read tStr
  For col As Integer = 1 To maskcols 
    mask(row, col) = Mid(tStr, col, 1)
  Next 
Next
'------------------------------------------------------------------------------
' find a clear place to start
Do
  row =Int(Rnd*maskrows+1) : col = Int(Rnd* maskcols+1)
Loop Until mask(row, col) <> maskbrush
'------------------------------------------------------------------------------
' standard distance for the Polar calculations, the angle (theta) will vary
radius = 1.414 : theta = 1
brush = Chr(176)
curColor = 2 : maskColor = 12
Locate row, col : Color curColor : Print "X";
'------------------------------------------------------------------------------
'MOTH MOVING
'key loop
While inkey <> "" : Wend
Do
  'MAKE NEW MOVE
  ' get radius, theta to move & translate to row, col (y,x)
  ' loop until a legal move is possible
  Do 'outer loop assures legal mask move
    Do ' inner loop assures legal row-col move
      tint = RndRange(1, 100)
      If tint < 96 Then
        thetaplus = RndRange(1, 2): If Chance(2) Then thetaplus =-RndRange(1, 2)
      ElseIf tint < 98 Then
        thetaplus = RndRange(3, 6): If Chance(2) Then thetaplus = -RndRange(3, 6)
      ElseIf tint < 99 Then
        thetaplus = RndRange(7, 14): If Chance(2) Then thetaplus = -RndRange(7, 14)
      Else
        thetaplus = RndRange(15, 30): If Chance(2) Then thetaplus = -RndRange(15, 30)
      End If
      theta += thetaplus
      If theta < 0 Then theta = 360 + theta
      If theta >= 360 Then theta = 360 - theta
      Polar2Cartesian(radius, theta)
    Loop Until row + cpy >= 1 And row + cpy <= maskrows And col + cpx >= 1 And col + cpx <= maskcols
  Loop Until mask(row + cpy, col + cpx) <> maskbrush ' will not release until valid

  'PLOT MOVE
  Color maskColor: Locate row, col: Print brush;
  row = row + cpy: col = col + cpx
  Color curColor
  Locate row, col
  Print "X";

  cnt += 1
  If cnt Mod 32 = 0 Then cnt = 0: Sleep 1
  
Loop Until inkey = Chr(27)
'==============================================================================
' COMMENT SECTION
'------------------------------------------------------------------------------
Comment4:
Data ""
Data "                            POWER OF THE MASK"
Data ""
Data "                    ALDOUS HUXLEY WATCHES THE SUNRISE"
Data ""
Data ""
Data ""
Data "I suppose you noticed the Quantum Moth fusses over some details, and"
Data "ignores others a long while.  Each time you run it, the pattern changes,"
Data "but I do notice it often has a problem with my nose."
Data ""
Data ""
Data "Now for something completely different.  The mask can be printed, or not"
Data "printed, as the coder wishes, to get the desired effect."
Data ""
Data ""
Data "In the last example of masking, the mask is the elaborate frame of a"
Data "window through which Aldous Huxley views the rising sun.  As a literary"
Data "man with an interesting brain, his sun is a little different."
Data ""
Data ""
Data ""
Data ""
Data ""
Data ""
Data ""
Data ""
Data ""
Data ""
Data ""
Data ""
Data ""
Data "           ...any key for 'Aldous Huxley Watches the Sunrise'..."
Data "enddata"
Restore comment4
ViewComment(14) 'data-to-viewport commentary
'------------------------------------------------------------------------------
'CODE SECTION
'------------------------------------------------------------------------------
'set up screen
w = 800 : h = 624
Screenres w, h, 8
Windowtitle "Simple FB Graphics Demo Series - ALDOUS HUXLEY WATCHES THE SUNRISE"
'define rows and columns
rows = 39 : cols = 100
Width cols, rows
Color ,BLACK
Cls
Dim Shared As Integer sh, sw, centRow, centCol
sh = h\16 : sw = w\8 : centRow = sh\2 : centCol = sw\2
maskrows = 37 : maskcols = 100
ReDim mask(maskrows, maskcols)
Dim Shared As Integer lineData(100,2)
'============================================================================== 
'read the text screen mask
Restore mask3
For row As Integer = 1 To maskrows
  Read tStr
  For col As Integer = 1 To maskcols 
    mask(row, col) = Mid(tStr, col, 1)
    If mask(row,col) = Chr$(219) Then
      Locate row,col
      Color 6
      Print Chr$(176);
    End If
  Next 
Next

'key loop
While inkey <> "" : Wend
cnt = 0
Do
  MakeLine() 'char pattern
  Locate 1,1
    For radius As Double = 1 To centCol
      ch = Chr(lineData(radius,1))
      hue = lineData(radius,2)
      For theta As Double = 0 To 360 Step 5
        Polar2Cartesian(radius, theta) 'uses radius, theta, modifies cpx, cpy
        If centRow + cpy > 1 And centCol + cpx > 1  And _
                   centRow + cpy < 37 And centCol + cpx < 100 Then
          If mask(centRow + cpy,centCol + cpx) = Chr(177) Then 
            Locate centRow + cpy, centCol + cpx
            Color hue
            Print ch;
          End If
        End If
        cnt +=1
        If cnt > 3 Then
          Sleep 1 : cnt = 0
        End If
      Next
    Next
Loop Until inkey = Chr(27)
'------------------------------------------------------------------------------
' FINAL COMMENT SECTION
'------------------------------------------------------------------------------
Commentlast:
Data ""
Data "                  POWER OF THE MASK - Last comment screen"
Data ""
Data ""
Data ""
Data "Thus endeth the masking lesson -- that you can design an array which can"
Data "control printing to the screen.  This saves a lot of coding effort and"
Data "makes a nice organized result."
Data ""
Data ""
Data "The main remaining issue is: how to make a mask.  It can be done by hand,"
Data "so to speak, meaning to write the data lines directly, and I have done"
Data "some of that.  Pretty tedious though, so I am working on a mask editor"
Data "to make it easier to practice creating masks, and to do good finished"
Data "masks for your project.  Coming soon..."
Data ""
Data ""
Data "Thanks for viewing this demo."
Data ""
Data ""
Data ""
Data ""
Data ""
Data ""
Data ""
Data ""
Data ""
Data ""
Data ""
Data ""
Data "                    ...any key to end the program..."
Data "enddata"
Restore commentlast
ViewComment(12) 'data-to-viewport commentary
'------------------------------------------------------------------------------
End  
'==============================================================================
Function RndRange(lo As Integer,hi As Integer) As Integer
  'Returns random number in a range, e.g. given range of
  '5 and 10 returns a num in range 5,6,7,8,9,10
   Return Int((Rnd*(hi-lo)+1)+lo)
End Function
'==============================================================================
Function Chance(hap As Integer = 2) As Integer
  'Chance of 1 in hap chances, e.g. given 3 it
  'returns -1 (True) if 3 and False (0) if 1 or 2
  Return Int(Rnd * hap + 1) = hap
End Function 
'==============================================================================
Sub MakeLine()
  For index As Integer = 1 To cols
    lineData(index,1)=RndRange(Asc("A"),Asc("Z")): If Rnd <.1 Then lineData(index,1)=32
    lineData(index,2)=RndRange(1,14)
  Next
End Sub
'=============================================================================
Sub Polar2Cartesian(cpdist As Double, cpangle As Double)
  ' all shared: cpdist = distance, cpangle = angle in deg, cpx and cpy will hold the result
  Dim As Double pi = 4 * Atn(1)
  cpangle = (360 + 270 - cpangle) Mod 360 'convert to fb draw convention
  cpx = cpdist * Cos(cpangle * (pi/180))
  cpy = cpdist * Sin(cpangle * (pi/180))
  If frac(cpx) >= .5 Then cpx = Fix(cpx) + 1
  If frac(cpy) >= .5 Then cpy = Fix(cpy) + 1
End Sub
'==============================================================================
Sub ViewComment(offset As Integer)
  'For comment to user: create viewport, read strings, print them
  'uses 8 x 16 chars for easier reading
  'exoects w, h to be const or shared

  Screenres 800, 624, 32
  Width 100, 39
  'Dim res As Integer = Width()
  'Print Hiword(res), Loword(res)
  'Sleep : End
  Color ,Rgb(&H0F,&H00,&H0F)
  Windowtitle "Simple FB Graphics Demo Series - COMMENT"
  Dim As Integer col = offset * 8, row = 16
  Dim As String text
  
  'control printing: offset = blank chars before text
  Cls
  Do
    Read text : If text = "enddata" Then Exit Do
    Draw String (col,row), text, Rgb(&H00,&HFF,&H00)
    row += 16
  Loop
  
  While Len(inkey) : Wend
  Sleep
End Sub
'==============================================================================
mask1:
Data "±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±"
Data "±ÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛ±"
Data "±Û±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±Û±"
Data "±Û±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±Û±"
Data "±Û±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±Û±"
Data "±Û±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±Û±"
Data "±Û±±±±ÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛ±±±±±±±±ÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛ±±±±±±±±Û±"
Data "±Û±±±±ÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛ±±±±±±±±ÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛ±±±±±±±Û±"
Data "±Û±±±±ÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛ±±±±±±±±ÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛ±±±±±±Û±"
Data "±Û±±±±ÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛ±±±±±±±±ÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛ±±±±±Û±"
Data "±Û±±±±ÛÛÛ±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±ÛÛÛÛÛ±±±±±±±±ÛÛÛ±±±±±±±±±±±±±±±±±±±±±±±±±±±±±ÛÛÛÛÛÛÛ±±±±Û±"
Data "±Û±±±±ÛÛÛ±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±ÛÛÛÛÛ±±±±±±±±ÛÛÛ±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±ÛÛÛÛÛÛ±±±±Û±"
Data "±Û±±±±ÛÛÛ±±ÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛ±±ÛÛÛÛÛ±±±±±±±±ÛÛÛ±±ÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛ±±±ÛÛÛÛÛ±±±±Û±"
Data "±Û±±±±ÛÛÛ±±ÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛ±±ÛÛÛÛÛ±±±±±±±±ÛÛÛ±±ÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛ±±ÛÛÛÛÛ±±±±Û±"
Data "±Û±±±±ÛÛÛ±±ÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛ±±ÛÛÛÛÛ±±±±±±±±ÛÛÛ±±ÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛ±±ÛÛÛÛÛ±±±±Û±"
Data "±Û±±±±ÛÛÛ±±ÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛ±±ÛÛÛÛÛ±±±±±±±±ÛÛÛ±±ÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛ±±ÛÛÛÛÛ±±±±Û±"
Data "±Û±±±±ÛÛÛ±±ÛÛÛÛÛ±±±±±±±±±±±±±±±±±±±±±±±±±±ÛÛÛÛÛ±±±±±±±±ÛÛÛ±±ÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛ±±ÛÛÛÛÛ±±±±Û±"
Data "±Û±±±±ÛÛÛ±±ÛÛÛÛÛ±±±±±±±±±±±±±±±±±±±±±±±±±±ÛÛÛÛÛ±±±±±±±±ÛÛÛ±±ÛÛÛÛÛÛ±±±±±±±±±±±±±±ÛÛÛÛÛÛÛ±±ÛÛÛÛÛ±±±±Û±"
Data "±Û±±±±ÛÛÛ±±ÛÛÛÛÛ±±ÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛ±±±±±±±±ÛÛÛ±±ÛÛÛÛÛÛ±±±±±±±±±±±±±±ÛÛÛÛÛÛÛ±±ÛÛÛÛÛ±±±±Û±"
Data "±Û±±±±ÛÛÛ±±ÛÛÛÛÛ±±ÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛ±±±±±±±±ÛÛÛ±±ÛÛÛÛÛÛ±±±±±±±±±±±±±±ÛÛÛÛÛÛÛ±±ÛÛÛÛÛ±±±±Û±"
Data "±Û±±±±ÛÛÛ±±ÛÛÛÛÛ±±ÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛ±±±±±±±±ÛÛÛ±±ÛÛÛÛÛÛ±±±±±±±±±±±±±±ÛÛÛÛÛÛÛ±±ÛÛÛÛÛ±±±±Û±"
Data "±Û±±±±ÛÛÛ±±ÛÛÛÛÛ±±ÛÛÛÛÛÛÛÛ±±±±±±±±±±±±±±±±±±±±±±±±±±±±±ÛÛÛ±±ÛÛÛÛÛÛ±±±±±±±±±±±±±±ÛÛÛÛÛÛÛ±±ÛÛÛÛÛ±±±±Û±"
Data "±Û±±±±ÛÛÛ±±ÛÛÛÛÛ±±ÛÛÛÛÛÛÛÛ±±±±±±±±±±±±±±±±±±±±±±±±±±±±±ÛÛÛ±±ÛÛÛÛÛÛ±±±±±±±±±±±±±±ÛÛÛÛÛÛÛ±±ÛÛÛÛÛ±±±±Û±"
Data "±Û±±±±ÛÛÛ±±ÛÛÛÛÛ±±ÛÛÛÛÛÛÛÛ±±±±±±±±±±±±±±±±±±±±±±±±±±±±±ÛÛÛ±±ÛÛÛÛÛÛ±±±±±±±±±±±±±±ÛÛÛÛÛÛÛ±±ÛÛÛÛÛ±±±±Û±"
Data "±Û±±±±ÛÛÛ±±ÛÛÛÛÛ±±ÛÛÛÛÛÛÛÛ±±±±±±±±±±±±±±±±±±±±±±±±±±±±±ÛÛÛ±±ÛÛÛÛÛÛ±±±±±±±±±±±±±±ÛÛÛÛÛÛÛ±±ÛÛÛÛÛ±±±±Û±"
Data "±Û±±±±ÛÛÛ±±ÛÛÛÛÛ±±ÛÛÛÛÛÛÛÛ±±±±±±±±±±±±±±±±±±±±±±±±±±±±±ÛÛÛ±±ÛÛÛÛÛÛ±±±±±±±±±±±±±±ÛÛÛÛÛÛÛ±±ÛÛÛÛÛ±±±±Û±"
Data "±Û±±±±ÛÛÛ±±ÛÛÛÛÛ±±ÛÛÛÛÛÛÛÛ±±±±±±±±±±±±±±±±±±±±±±±±±±±±±ÛÛÛ±±ÛÛÛÛÛÛ±±±±±±±±±±±±±±ÛÛÛÛÛÛÛ±±ÛÛÛÛÛ±±±±Û±"
Data "±Û±±±±ÛÛÛ±±ÛÛÛÛÛ±±ÛÛÛÛÛÛÛÛ±±±±±±±±±±±±±±±±±±±±±±±±±±±±±ÛÛÛ±±ÛÛÛÛÛÛ±±±±±±±±±±±±±±ÛÛÛÛÛÛÛ±±ÛÛÛÛÛ±±±±Û±"
Data "±Û±±±±ÛÛÛ±±ÛÛÛÛÛ±±ÛÛÛÛÛÛÛÛ±±±±±±±±±±±±±±±±±±±±±±±±±±±±±ÛÛÛ±±ÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛ±±ÛÛÛÛÛ±±±±Û±"
Data "±Û±±±±ÛÛÛ±±ÛÛÛÛÛ±±ÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛ±±±±±±±±±±±±±±±±±±ÛÛÛ±±ÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛ±±±ÛÛÛÛÛ±±±±Û±"
Data "±Û±±±±ÛÛÛ±±ÛÛÛÛÛ±±ÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛ±±±±±±±±±±±±±±±±±±ÛÛÛ±±ÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛ±±±±ÛÛÛÛÛ±±±±Û±"
Data "±Û±±±±ÛÛÛ±±ÛÛÛÛÛ±±ÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛ±±±±±±±±±±±±±±±±±±ÛÛÛ±±ÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛ±±±ÛÛÛÛÛ±±±±±±Û±"
Data "±Û±±±±ÛÛÛ±±ÛÛÛÛÛ±±±±±±±±±±±±±±±ÛÛÛÛÛÛ±±±±±±±±±±±±±±±±±±ÛÛÛ±±ÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛ±±±ÛÛÛÛÛ±±±±±±±Û±"
Data "±Û±±±±ÛÛÛ±±ÛÛÛÛÛ±±±±±±±±±±±±±±±ÛÛÛÛÛÛ±±±±±±±±±±±±±±±±±±ÛÛÛ±±±±±±±±±±±±±±±±±±±±±±±±±±±±ÛÛÛÛ±±±±±±±±Û±"
Data "±Û±±±±ÛÛÛ±±ÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛ±±ÛÛÛÛÛÛ±±±±±±±±±±±±±±±±±±ÛÛÛ±±±±±±±±±±±±±±±±±±±±±±±±±±±±ÛÛÛÛÛ±±±±±±±Û±"
Data "±Û±±±±ÛÛÛ±±ÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛ±±ÛÛÛÛÛÛ±±±±±±±±±±±±±±±±±±ÛÛÛ±±ÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛ±±±ÛÛÛÛÛ±±±±±±Û±"
Data "±Û±±±±ÛÛÛ±±ÛÛÛÛÛ±±±±±±±±±±±±±±±ÛÛÛÛÛÛ±±±±±±±±±±±±±±±±±±ÛÛÛ±±ÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛ±±ÛÛÛÛÛÛÛ±±±±Û±"
Data "±Û±±±±ÛÛÛ±±ÛÛÛÛÛ±±±±±±±±±±±±±±±ÛÛÛÛÛÛ±±±±±±±±±±±±±±±±±±ÛÛÛ±±ÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛ±±ÛÛÛÛÛÛ±±±±Û±"
Data "±Û±±±±ÛÛÛ±±ÛÛÛÛÛ±±ÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛ±±±±±±±±±±±±±±±±±±ÛÛÛ±±ÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛ±±±ÛÛÛÛÛ±±±±Û±"
Data "±Û±±±±ÛÛÛ±±ÛÛÛÛÛ±±ÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛ±±±±±±±±±±±±±±±±±±ÛÛÛ±±ÛÛÛÛÛÛ±±±±±±±±±±±±±±±ÛÛÛÛÛÛ±±ÛÛÛÛÛ±±±±Û±"
Data "±Û±±±±ÛÛÛ±±ÛÛÛÛÛ±±ÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛ±±±±±±±±±±±±±±±±±±ÛÛÛ±±ÛÛÛÛÛÛ±±±±±±±±±±±±±±±ÛÛÛÛÛÛ±±ÛÛÛÛÛ±±±±Û±"
Data "±Û±±±±ÛÛÛ±±ÛÛÛÛÛ±±ÛÛÛÛÛÛÛÛ±±±±±±±±±±±±±±±±±±±±±±±±±±±±±ÛÛÛ±±ÛÛÛÛÛÛ±±±±±±±±±±±±±±±ÛÛÛÛÛÛ±±ÛÛÛÛÛ±±±±Û±"
Data "±Û±±±±ÛÛÛ±±ÛÛÛÛÛ±±ÛÛÛÛÛÛÛÛ±±±±±±±±±±±±±±±±±±±±±±±±±±±±±ÛÛÛ±±ÛÛÛÛÛÛ±±±±±±±±±±±±±±±ÛÛÛÛÛÛ±±ÛÛÛÛÛ±±±±Û±"
Data "±Û±±±±ÛÛÛ±±ÛÛÛÛÛ±±ÛÛÛÛÛÛÛÛ±±±±±±±±±±±±±±±±±±±±±±±±±±±±±ÛÛÛ±±ÛÛÛÛÛÛ±±±±±±±±±±±±±±±ÛÛÛÛÛÛ±±ÛÛÛÛÛ±±±±Û±"
Data "±Û±±±±ÛÛÛ±±ÛÛÛÛÛ±±ÛÛÛÛÛÛÛÛ±±±±±±±±±±±±±±±±±±±±±±±±±±±±±ÛÛÛ±±ÛÛÛÛÛÛ±±±±±±±±±±±±±±±ÛÛÛÛÛÛ±±ÛÛÛÛÛ±±±±Û±"
Data "±Û±±±±ÛÛÛ±±ÛÛÛÛÛ±±ÛÛÛÛÛÛÛÛ±±±±±±±±±±±±±±±±±±±±±±±±±±±±±ÛÛÛ±±ÛÛÛÛÛÛ±±±±±±±±±±±±±±±ÛÛÛÛÛÛ±±ÛÛÛÛÛ±±±±Û±"
Data "±Û±±±±ÛÛÛ±±ÛÛÛÛÛ±±ÛÛÛÛÛÛÛÛ±±±±±±±±±±±±±±±±±±±±±±±±±±±±±ÛÛÛ±±ÛÛÛÛÛÛ±±±±±±±±±±±±±±±ÛÛÛÛÛÛ±±ÛÛÛÛÛ±±±±Û±"
Data "±Û±±±±ÛÛÛ±±ÛÛÛÛÛ±±ÛÛÛÛÛÛÛÛ±±±±±±±±±±±±±±±±±±±±±±±±±±±±±ÛÛÛ±±ÛÛÛÛÛÛ±±±±±±±±±±±±±±±ÛÛÛÛÛÛ±±ÛÛÛÛÛ±±±±Û±"
Data "±Û±±±±ÛÛÛ±±ÛÛÛÛÛ±±ÛÛÛÛÛÛÛÛ±±±±±±±±±±±±±±±±±±±±±±±±±±±±±ÛÛÛ±±ÛÛÛÛÛÛ±±±±±±±±±±±±±±±ÛÛÛÛÛÛ±±ÛÛÛÛÛ±±±±Û±"
Data "±Û±±±±ÛÛÛ±±ÛÛÛÛÛ±±ÛÛÛÛÛÛÛÛ±±±±±±±±±±±±±±±±±±±±±±±±±±±±±ÛÛÛ±±ÛÛÛÛÛÛ±±±±±±±±±±±±±±±ÛÛÛÛÛÛ±±ÛÛÛÛÛ±±±±Û±"
Data "±Û±±±±ÛÛÛ±±ÛÛÛÛÛ±±ÛÛÛÛÛÛÛÛ±±±±±±±±±±±±±±±±±±±±±±±±±±±±±ÛÛÛ±±ÛÛÛÛÛÛ±±±±±±±±±±±±±±±ÛÛÛÛÛÛ±±ÛÛÛÛÛ±±±±Û±"
Data "±Û±±±±ÛÛÛ±±ÛÛÛÛÛ±±ÛÛÛÛÛÛÛÛ±±±±±±±±±±±±±±±±±±±±±±±±±±±±±ÛÛÛ±±ÛÛÛÛÛÛ±±±±±±±±±±±±±±±ÛÛÛÛÛÛ±±ÛÛÛÛÛ±±±±Û±"
Data "±Û±±±±ÛÛÛ±±ÛÛÛÛÛ±±ÛÛÛÛÛÛÛÛ±±±±±±±±±±±±±±±±±±±±±±±±±±±±±ÛÛÛ±±ÛÛÛÛÛÛ±±±±±±±±±±±±±±±ÛÛÛÛÛÛ±±ÛÛÛÛÛ±±±±Û±"
Data "±Û±±±±ÛÛÛ±±ÛÛÛÛÛ±±ÛÛÛÛÛÛÛÛ±±±±±±±±±±±±±±±±±±±±±±±±±±±±±ÛÛÛ±±ÛÛÛÛÛÛ±±±±±±±±±±±±±±±ÛÛÛÛÛÛ±±ÛÛÛÛÛ±±±±Û±"
Data "±Û±±±±ÛÛÛ±±ÛÛÛÛÛ±±ÛÛÛÛÛÛÛÛ±±±±±±±±±±±±±±±±±±±±±±±±±±±±±ÛÛÛ±±ÛÛÛÛÛÛ±±±±±±±±±±±±±±±ÛÛÛÛÛÛ±±ÛÛÛÛÛ±±±±Û±"
Data "±Û±±±±ÛÛÛ±±ÛÛÛÛÛ±±ÛÛÛÛÛÛÛÛ±±±±±±±±±±±±±±±±±±±±±±±±±±±±±ÛÛÛ±±ÛÛÛÛÛÛ±±±±±±±±±±±±±±±ÛÛÛÛÛÛ±±ÛÛÛÛÛ±±±±Û±"
Data "±Û±±±±ÛÛÛ±±ÛÛÛÛÛ±±ÛÛÛÛÛÛÛÛ±±±±±±±±±±±±±±±±±±±±±±±±±±±±±ÛÛÛ±±ÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛ±±ÛÛÛÛÛ±±±±Û±"
Data "±Û±±±±ÛÛÛ±±ÛÛÛÛÛ±±ÛÛÛÛÛÛÛÛ±±±±±±±±±±±±±±±±±±±±±±±±±±±±±ÛÛÛ±±ÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛ±±ÛÛÛÛÛ±±±±Û±"
Data "±Û±±±±ÛÛÛ±±ÛÛÛÛÛ±±ÛÛÛÛÛÛÛÛ±±±±±±±±±±±±±±±±±±±±±±±±±±±±±ÛÛÛ±±ÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛ±±ÛÛÛÛÛ±±±±Û±"
Data "±Û±±±±ÛÛÛ±±ÛÛÛÛÛ±±ÛÛÛÛÛÛÛÛ±±±±±±±±±±±±±±±±±±±±±±±±±±±±±ÛÛÛ±±ÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛ±±ÛÛÛÛÛ±±±±Û±"
Data "±Û±±±±ÛÛÛ±±ÛÛÛÛÛ±±ÛÛÛÛÛÛÛÛ±±±±±±±±±±±±±±±±±±±±±±±±±±±±±ÛÛÛ±±ÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛ±±±ÛÛÛÛÛ±±±±Û±"
Data "±Û±±±±ÛÛÛ±±ÛÛÛÛÛ±±ÛÛÛÛÛÛÛÛ±±±±±±±±±±±±±±±±±±±±±±±±±±±±±ÛÛÛ±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±ÛÛÛÛÛÛ±±±±Û±"
Data "±Û±±±±ÛÛÛ±±±±±±±±±ÛÛÛÛÛÛÛÛ±±±±±±±±±±±±±±±±±±±±±±±±±±±±±ÛÛÛ±±±±±±±±±±±±±±±±±±±±±±±±±±±±±ÛÛÛÛÛÛÛ±±±±Û±"
Data "±Û±±±±ÛÛÛ±±±±±±±±±ÛÛÛÛÛÛÛÛ±±±±±±±±±±±±±±±±±±±±±±±±±±±±±ÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛ±±±±±Û±"
Data "±Û±±±±ÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛ±±±±±±±±±±±±±±±±±±±±±±±±±±±±±ÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛ±±±±±±Û±"
Data "±Û±±±±ÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛ±±±±±±±±±±±±±±±±±±±±±±±±±±±±±ÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛ±±±±±±±Û±"
Data "±Û±±±±ÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛ±±±±±±±±±±±±±±±±±±±±±±±±±±±±±ÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛ±±±±±±±±Û±"
Data "±Û±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±Û±"
Data "±Û±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±Û±"
Data "±Û±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±Û±"
Data "±Û±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±Û±"
Data "±ÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛ±"
Data "±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±"
Data "enddata"
mask2:
Data "ÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛ²²²²²²²²²²²²²²²²ÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛ²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²"
Data "Û²²²Û²Û²²²²²Û²Û²²²²²²²²²²²²²ÛÛÛÛ²²²²²²²²²²²²²²ÛÛÛ²²²²²²²²²²²²²²²²²²²ÛÛÛ²ÛÛ²²Û²ÛÛÛÛ²²ÛÛ²Û²²ÛÛÛ²²²²²²Û"
Data "Û²Û²Û²Û²²ÛÛ²Û²Û²²²²²²²²²²²ÛÛÛ²²²²²²²²²²²²²²²²²²²ÛÛ²²²²²²²²²²²²²²²²²²ÛÛÛ²²Û²ÛÛÛÛÛ²²²ÛÛ²²Û²²ÛÛÛ²²²²²²Û"
Data "Û²Û²Û²Û²²²Û²²Û²Û²²²²²²²²²²ÛÛ²²²ÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛ²²Û²²²²²²²²²²²²²²²²²²ÛÛÛ²²ÛÛÛÛÛÛ²²²ÛÛÛÛÛÛ²²ÛÛÛ²²²²²²Û"
Data "ÛÛ²²Û²Û²²²Û²²Û²Û²²²²²²²²²ÛÛÛÛ²Û²²²²²²²²²²²²²²²²Û²Û²²²²²²²²²²²²²²²²²²ÛÛÛ²²²ÛÛÛ²²²²²²ÛÛÛ²²²²ÛÛÛ²²²²²²Û"
Data "ÛÛ²²Û²²Û²²Û²²Û²Û²²²²²²²²²Û²Û²ÛÛ²²²²²²²²²²²²²²²²²ÛÛ²²²²²²²²²²²²²²²²²²ÛÛÛ²²²²²ÛÛÛÛÛÛÛÛ²²²²²²ÛÛÛ²²²²²²Û"
Data "ÛÛ²Û²²²Û²²Û²²Û²ÛÛ²²²²²²²²Û²²ÛÛ²²²²ÛÛÛÛÛ²²ÛÛÛÛÛ²²Û²²²²²²²²²²²²²²²²²²²ÛÛÛ²²²²²²²²²²²²²²²²²²²ÛÛÛ²²²²²²Û"
Data "Û²²Û²²²Û²²ÛÛ²ÛÛ²Û²²²²²²²²ÛÛ²ÛÛ²²²²²²²²Û²²Û²²²²²²Û²²²²²²²²²²²²²²²²²²²ÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛ²²²²²²Û"
Data "Û²²Û²²²²²²²Û²²²²²Û²²²²²²²²Û²ÛÛÛ²²²²²²²²²²²Û²²²²²ÛÛÛÛÛÛÛÛÛÛÛÛÛ²²²²²²²ÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛ²²²²²²Û"
Data "Û²ÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛ²²²ÛÛÛÛÛÛ²Û²Û²²²²²²ÛÛÛÛÛÛ²²²²ÛÛ²²²²²²²²²²²²ÛÛÛÛÛÛ²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²Û"
Data "²²²²²²²²²²²²²²²²²²²²ÛÛ²²²²²²Û²ÛÛ²²²ÛÛÛ²²²²ÛÛÛ²ÛÛ²²²²²²²²²²²²²²²²²ÛÛÛÛÛÛÛ²²²²²²²²²²²²²²²²²²²²²²²²²²²Û"
Data "²Û²Û²Û²²²²²²²²²²²²ÛÛ²²²²²²²²²Û²ÛÛÛÛ²ÛÛÛÛÛÛ²ÛÛÛÛ²²²²²²²²²²²²²²²²²²²²²²²²ÛÛÛÛ²²²²²²²²²²²²²²²²²²²²²²²²Û"
Data "²Û²Û²Û²²²²²²²²²ÛÛÛ²²²²²²²²²²²²ÛÛ²²²²²²²²²²²²²²Û²²²²²²²²²²²²²²²²²²²²²²²²²²²²ÛÛ²²²²²²²²²²²²²²²²²²²²²²Û"
Data "²Û²Û²Û²²²²²ÛÛÛÛÛ²²²²²²²²²²²²²²²ÛÛ²²²²²²²²²²²²ÛÛ²²²²²²²Û²²²²²²²²²²²²²²²²²²²²²ÛÛ²²²²²²²²²²²²²²²²²²²²²²"
Data "²Û²Û²Û²²ÛÛÛÛÛÛÛ²²²²²²²²²²²²²²²²²²ÛÛÛ²²²²²²²²ÛÛ²²²²²²²²²²ÛÛÛ²²²²²²²²²²²²²²²²²²²ÛÛ²²²²²²²²²²²ÛÛ²²ÛÛÛÛÛ"
Data "²Û²Û²Û²ÛÛÛÛÛÛÛ²²²²²²²²²²²²²²²²²²²²ÛÛÛÛÛÛÛÛÛÛ²²²²²²²²²²²²ÛÛÛÛ²²²²²²²²²²²²²²²²²²ÛÛ²²²²²²²²²ÛÛÛ²²²²²²²²"
Data "²Û²Û²ÛÛÛÛÛÛÛÛ²²²²²²²²²²²²²²²²²²²²²²²²²²²²²ÛÛ²²²²²²²²²²²²²ÛÛÛÛÛÛÛ²²²²²²²²²²²²²²ÛÛÛ²²²²²²²ÛÛ²²²²²²²²²²"
Data "²Û²Û²ÛÛÛÛÛÛÛÛ²²²²²²²²²²²²²²Û²²²²²²²²²²²²²²²ÛÛ²²²²²²²²²²²²²²ÛÛÛÛÛÛÛ²²²²²²²²²²²²ÛÛÛ²²²²²²ÛÛ²²²²²²²²²²²"
Data "²Û²Û²ÛÛÛÛÛÛÛÛ²²²²²²²²²²²²²²ÛÛ²²²²²²²²²²²²²²²ÛÛ²²²²²²²²²²²²²²ÛÛÛÛÛÛ²²²²²²²²²²²ÛÛÛÛ²²²²²²ÛÛ²²²²²²²²²²²"
Data "²Û²ÛÛÛÛÛÛÛÛÛÛ²²²²²²²²²²²²²²²Û²²²²²²²²²²²²²²²²²ÛÛ²²²²²²²²²²²²²ÛÛÛÛÛ²ÛÛÛÛÛÛ²²²ÛÛÛÛÛÛ²²²²²²²ÛÛÛ²²²²²²²²"
Data "²Û²ÛÛÛÛÛÛÛÛÛÛ²²²²²²²²²²²²²²²Û²²²²²²²²²²²²²²²²²²²ÛÛÛ²²²²²²²²²²²²ÛÛÛÛÛ²²²²²ÛÛÛÛÛÛÛÛÛ²²²²²²²²²²ÛÛÛÛÛÛÛÛ"
Data "²Û²ÛÛÛÛÛÛÛÛÛÛÛ²²²²²²²²²²²²²²²Û²²²²²²²²²²²²²²²²²²²²Û²²²²²²²²²²²²²ÛÛÛ²²²²²²²²ÛÛÛÛÛÛÛ²²²²²²²²²²²²²²²²²Û"
Data "²Û²ÛÛÛÛÛÛÛÛÛÛÛ²²²²²²²²²²²²²²²Û²²²²²²²²²²²²²²²²²²²²ÛÛÛ²²²²²²²²²²²²ÛÛ²²²²²²²²ÛÛÛÛÛÛÛÛÛÛÛÛÛ²²²²²²²²²²²Û"
Data "²Û²ÛÛÛÛÛÛÛÛÛÛÛ²²²²²²²²²²²²²Û²ÛÛ²²²²²²²²²²²²²²²²²²²²²²ÛÛ²²²²²²²²²²ÛÛ²²²²²²²Û²Û²²²²²²²²²²²ÛÛÛÛÛ²²²²²²Û"
Data "²Û²ÛÛÛÛÛÛÛÛÛÛÛÛ²²²²²²²²²²²²²ÛÛÛÛ²²²²²²²²²²²²²²²²²²²²²²ÛÛ²²²²²²²²²²ÛÛ²Û²Û²ÛÛÛ²²²²²²²²²²²²²²²²ÛÛÛ²²²²Û"
Data "²Û²ÛÛÛÛÛÛÛÛÛÛÛÛ²²²²²²²²²²²²²²²²ÛÛÛÛÛÛÛÛ²²²²²²²²²²²²²²²²ÛÛ²²²²²²²²²²Û²Û²ÛÛÛ²²²²²²²²²²²²²²²²²²²²²ÛÛ²²Û"
Data "²Û²ÛÛÛÛÛÛÛÛÛÛÛÛ²²²²²²²²²²²²²²²²²²²²²²²ÛÛÛÛÛ²²²²²²²²²²²²²²ÛÛÛ²²²²ÛÛÛÛ²ÛÛÛ²²²²²²²²²²²²²²²²²²²²²²²²²²²Û"
Data "²Û²ÛÛÛÛÛÛÛÛÛÛÛÛÛ²²²²²²²²²²²²²²²²²²²²²²²²²ÛÛÛÛ²²²²²²²²²²²²²²ÛÛÛÛÛÛ²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²Û"
Data "²Û²Û²ÛÛÛÛÛÛÛÛÛÛÛÛ²²²²²²²²²²²²²²²²²²²²²²²ÛÛ²²²²ÛÛÛÛ²²²²²ÛÛÛÛÛÛÛ²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²Û"
Data "²Û²Û²ÛÛÛÛÛÛÛÛÛÛÛÛÛ²²²²²²²²²²²²²²²²²²²²²²Û²²²²²²²²²ÛÛ²²²²²²²²²ÛÛÛÛ²²²²²²²²²²²²²²²²ÛÛ²²²²²²²²²²²²²²²²Û"
Data "²Û²²²ÛÛÛÛÛÛÛÛÛÛÛÛÛÛ²²²²²²²²²²²²²²²²²²²²²Û²²²²²²²²²²²ÛÛ²²²²²²²²ÛÛÛÛÛÛÛ²²²²²²²²²²²²²ÛÛ²²²²²²²²²²²²²²²Û"
Data "²Û²²²²ÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛ²²²²²²²²²²²²²²²²²ÛÛ²²²²²²²²²²²ÛÛ²²²²²²²²²²²²²ÛÛÛÛÛÛÛÛ²²²²ÛÛÛÛÛ²²²²²²²²²²²²²²Û"
Data "²Û²Û²²²ÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛ²²²²²²²²²²²²²²²Û²²²²²²²²²²²ÛÛ²²²²²²²²²²²²²²²²²²²ÛÛÛÛÛÛÛÛÛÛÛ²²²²²²²²²²²²²Û"
Data "²Û²²ÛÛ²²²ÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛ²²²²²²²ÛÛÛÛÛÛ²²²Û²²Û²Û²Û²²²²²²²²²²²²²²²²²²²²²²ÛÛÛÛÛÛÛÛÛ²²²²²²²²²²²²Û"
Data "²Û²²ÛÛÛÛ²²ÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛ²²²ÛÛÛÛÛÛÛÛÛÛÛÛÛ²²Û²²Û²Û²Û²²²²²²²²²²²²²²²²²²²²²²²²²ÛÛÛÛÛÛÛ²²²²²²²²²²²Û"
Data "²Û²²²ÛÛÛÛ²²²ÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛ²²²ÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛ²²Û²²Û²Û²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²"
Data "²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²ÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛ²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²"
Data "enddata"
mask3:
Data "ÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛ"
Data "ÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛ"
Data "ÛÛÛ±±Û±±Û±±ÛÛ±±±±±±±±±±±±±±±±±ÛÛ±±±±±±±±±±±±±±±±±ÛÛ±±±±±±±±±±±±±±±±±±ÛÛ±±±±±±±±±±±±±±±±ÛÛ±±Û±±Û±±ÛÛÛ"
Data "ÛÛÛ±±Û±±Û±±ÛÛ±±±±±±±±±±±±±±±±±ÛÛ±±±±±±±±±±±±±±±±±ÛÛ±±±±±±±±±±±±±±±±±±ÛÛ±±±±±±±±±±±±±±±±ÛÛ±±Û±±Û±±ÛÛÛ"
Data "ÛÛÛ±±Û±±Û±±ÛÛ±±±±±±±±±±±±±±±±±ÛÛ±±±±±±±±±±±±±±±±±ÛÛ±±±±±±±±±±±±±±±±±±ÛÛ±±±±±±±±±±±±±±±±ÛÛ±±Û±±Û±±ÛÛÛ"
Data "ÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛ"
Data "ÛÛÛ±±±±±±±±ÛÛ±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±ÛÛ±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±ÛÛ±±±±±±±±ÛÛÛ"
Data "ÛÛÛ±±±±±±±±ÛÛ±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±ÛÛ±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±ÛÛ±±±±±±±±ÛÛÛ"
Data "ÛÛÛ±±±±±±±±ÛÛ±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±ÛÛ±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±ÛÛ±±±±±±±±ÛÛÛ"
Data "ÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛ"
Data "ÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛ"
Data "ÛÛÛ±±Û±±Û±±ÛÛ±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±ÛÛ±±Û±±Û±±ÛÛÛ"
Data "ÛÛÛ±±Û±±Û±±ÛÛ±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±ÛÛ±±Û±±Û±±ÛÛÛ"
Data "ÛÛÛ±±Û±±Û±±ÛÛ±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±ÛÛ±±Û±±Û±±ÛÛÛ"
Data "ÛÛÛÛÛÛÛÛÛÛÛÛÛ±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±ÛÛÛÛÛÛÛÛÛÛÛÛÛ"
Data "ÛÛÛ±±±±±±±±ÛÛ±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±ÛÛ±±±±±±±±ÛÛÛ"
Data "ÛÛÛ±±±±±±±±ÛÛ±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±ÛÛ±±±±±±±±ÛÛÛ"
Data "ÛÛÛ±±±±±±±±ÛÛ±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±ÛÛ±±±±±±±±ÛÛÛ"
Data "ÛÛÛ±±±±±±±±ÛÛ±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±ÛÛ±±±±±±±±ÛÛÛ"
Data "ÛÛÛÛÛÛÛÛÛÛÛÛÛ±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±ÛÛÛÛÛÛÛÛÛÛÛÛÛ"
Data "ÛÛÛÛÛÛÛÛÛÛÛÛÛ±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±ÛÛÛÛÛÛÛÛÛÛÛÛÛ"
Data "ÛÛÛ±±Û±±Û±±ÛÛ±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±ÛÛ±±Û±±Û±±ÛÛÛ"
Data "ÛÛÛ±±Û±±Û±±ÛÛ±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±ÛÛ±±Û±±Û±±ÛÛÛ"
Data "ÛÛÛ±±Û±±Û±±ÛÛ±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±ÛÛ±±Û±±Û±±ÛÛÛ"
Data "ÛÛÛ±±Û±±Û±±ÛÛ±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±ÛÛ±±Û±±Û±±ÛÛÛ"
Data "ÛÛÛ±±Û±±Û±±ÛÛ±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±ÛÛ±±Û±±Û±±ÛÛÛ"
Data "ÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛ"
Data "ÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛ"
Data "ÛÛÛ±±Û±±Û±±ÛÛ±±±±±±±±ÛÛ±±±±±±±±±±±±±±±±±ÛÛ±±±±±±±±±±±±±±±±±±ÛÛ±±±±±±±±±±±±±±±±ÛÛ±±±±±±±ÛÛ±±Û±±Û±±ÛÛÛ"
Data "ÛÛÛ±±Û±±Û±±ÛÛ±±±±±±±±ÛÛ±±±±±±±±±±±±±±±±±ÛÛ±±±±±±±±±±±±±±±±±±ÛÛ±±±±±±±±±±±±±±±±ÛÛ±±±±±±±ÛÛ±±Û±±Û±±ÛÛÛ"
Data "ÛÛÛ±±Û±±Û±±ÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛ±±Û±±Û±±ÛÛÛ"
Data "ÛÛÛ±±Û±±Û±±ÛÛ±±±±±±±±±±±±±±±±ÛÛÛ±±±±±±±±±±±±±±±±±±ÛÛÛ±±±±±±±±±±±±±±±±ÛÛÛ±±±±±±±±±±±±±±±ÛÛ±±Û±±Û±±ÛÛÛ"
Data "ÛÛÛ±±Û±±Û±±ÛÛ±±±±±±±±±±±±±±±±ÛÛÛ±±±±±±±±±±±±±±±±±±ÛÛÛ±±±±±±±±±±±±±±±±ÛÛÛ±±±±±±±±±±±±±±±ÛÛ±±Û±±Û±±ÛÛÛ"
Data "ÛÛÛ±±Û±±Û±±ÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛ±±Û±±Û±±ÛÛÛ"
Data "ÛÛÛ±±Û±±Û±±ÛÛ±±±±±±±±±±±±±±±±ÛÛÛ±±±±±±±±±±±±±±±±±±ÛÛÛ±±±±±±±±±±±±±±±±ÛÛÛ±±±±±±±±±±±±±±±ÛÛ±±Û±±Û±±ÛÛÛ"
Data "ÛÛÛ±±Û±±Û±±ÛÛ±±±±±±±±±±±±±±±±ÛÛÛ±±±±±±±±±±±±±±±±±±ÛÛÛ±±±±±±±±±±±±±±±±ÛÛÛ±±±±±±±±±±±±±±±ÛÛ±±Û±±Û±±ÛÛÛ"
Data "ÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛ"
Data "enddata"
Top
tinram
Posts: 89
Joined: Nov 30, 2006 13:35
Location: UK

Re: Love and Letter-bots

Post by tinram »

Impressive and interesting program.

Did you create your data section in an ASCII art program, or do it from scratch?
Top
caseih
Posts: 2157
Joined: Feb 26, 2007 5:32

Re: Love and Letter-bots

Post by caseih »

What is the quantum moth screen supposed to do? I don't see anything except random X's popping up.
Top
Quark
Posts: 474
Joined: May 27, 2011 18:16
Location: Pennsylvania, U.S.
Contact:
Contact Quark

Re: Love and Letter-bots

Post by Quark »

.
@ Tinram
Impressive and interesting program.

Did you create your data section in an ASCII art program, or do it from scratch?
Thanks for your interest. Love and Letter-bots was a pleasure to make, and I still like seeing it it every time I run it.

I mentioned in the second program posted that i work in an editor I wrote for the purpose, and which I will be making available soon. I have done some work directly in data statements, but that is quite a bit of effort. Check back in a few days for the mask editor. I am fairly pleased with it in that, while it is not overly complex for code, it works fine and even allows the user to load a previous mask for further work, and it saves with an auto-generated filename so the user does not have to type in a filename. It will have several 'brushes' for more elaborate masking possibilities, meaning each brush or character gives new options.

@caseth

Sorry you were not able to view the Quantum Moth at work. It creates a simple portrait of a former me sitting in a chair, as you can see if you look at the mask data lines at the bottom of the code. It shows fine on my Vista machine; what are you using? Did the other mask mini-demos work for you? Maybe we can figure out the problem.
.
Top
caseih
Posts: 2157
Joined: Feb 26, 2007 5:32

Re: Love and Letter-bots

Post by caseih »

Running it on Linux. All I get is a screen full of red chr(176), with yellow X's flashing on in a random pattern, before disappearing behind red chr(176) again.

Anyway, no worries.
Top
Quark
Posts: 474
Joined: May 27, 2011 18:16
Location: Pennsylvania, U.S.
Contact:
Contact Quark

Re: Love and Letter-bots

Post by Quark »

.
@caseth

Well, yeah, worries, if the code is not working for you. But it is odd, as the code in that part of the program is fairly straight-forward:

Code: Select all

...
Loop Until mask(row + cpy, col + cpx) <> maskbrush ' will not release until valid

  'PLOT MOVE
  Color maskColor: Locate row, col: Print brush;
  row = row + cpy: col = col + cpx
  Color curColor
  Locate row, col
  Print "X";
So, it prints a green 'X' where the mask says it can, then deletes the 'X' with the red chr(176). This reveals the black area that is not printed to, which is the portrait. First guess is that the mask is not loading correctly to provide its limits on where the Quantum Moth can flit. I'm not sure what happens when the QM is frustrated (brrr) :-(
.
Top
caseih
Posts: 2157
Joined: Feb 26, 2007 5:32

Re: Love and Letter-bots

Post by caseih »

I suppose it could be of interest if this exposes a bug in the FB compiler or runtime on Linux. I'll fire up the windows version and compare it on my own computer here.
Top
Quark
Posts: 474
Joined: May 27, 2011 18:16
Location: Pennsylvania, U.S.
Contact:
Contact Quark

Re: Love and Letter-bots

Post by Quark »

.
@caseth

Good that you can check on a Windows OS to see if that works. Hope so.
.
Top
Quark
Posts: 474
Joined: May 27, 2011 18:16
Location: Pennsylvania, U.S.
Contact:
Contact Quark

Re: Love and Letter-bots

Post by Quark »

.
Here is the promised Mask Maker V1.0 editor for making masks. Use of the masks has been demonstrated in the files I have previously uploaded in this thread. The information below is from the comment lines at the top of the Mask Maker file:
'================================================================================
' Purpose: One of a series of graphics programs using common FreeBasic commands.
' This one makes 100 column, 73 row, screen masks saved as DATA strings.
' Character size is 8x8.
' Has 4 drawing 'brushes' to expand masking options.
' Uses Bresenham algorithm for LINE.
'==============================================================================
' Build a mask for the screen to provide open and closed areas
' Uses the mouse to draw a mask for an 800x600 screen in 8x8 char size.
' Use 'INCLUDE 'MASKNAME.BI' to include data lines in a prg, or paste the lines.
' COMMANDS: <D>-Draw <L>-Line <B>-Brush <C>-Clear canvas <F>-Load/Save <Q>-Quit (No Save)
' DRAW: LEFT-click mouse & drag to draw; RIGHT-click & drag to erase.
' LINE: Click on line ends: LEFT-click For drawing; RIGHT-click for erase; 'U' for UNDO LINE
' BRUSH: <B> Cycle through draw brushes.
' CLEAR: <C> to clear the mask.
' FILE: <L> Load a mask from file (26 file-choices max) <S> Save current mask
' Note: the current mask is saved to a uniquely-named (time-based) file automatically.
' QUIT <Q> to exit program.
'==============================================================================
.

Code: Select all

'================================================================================
' Mask_Maker_8x8_V1.0.bas by Quark 12/20/14
' Using FreeBASIC Compiler - Version 1.00.0 (09-14-2014), for win32 (32bit)
' Use it freely, modify it freely and any responsibility is yours.
'================================================================================
' Purpose: One of a series of graphics programs using common FreeBasic commands.
' This one makes 100 column, 73 row, screen masks saved as DATA strings.
' Character size is 8x8.
' Has 4 drawing 'brushes' to expand masking options.
' Uses Bresenham algorithm for LINE.
'==============================================================================    
' Build a mask for the screen to provide open and closed areas
' Uses the mouse to draw a mask for an 800x600 screen in 8x8 char size.
' Use 'INCLUDE 'MASKNAME.BI' to include data lines in a prg, or paste the lines.
' COMMANDS: <D>-Draw  <L>-Line  <B>-Brush  <C>-Clear canvas  <F>-Load/Save  <Q>-Quit (No Save)
' DRAW: LEFT-click mouse & drag to draw; RIGHT-click & drag to erase.   
' LINE: Click on line ends: LEFT-click For drawing; RIGHT-click for erase; 'U' for UNDO LINE
' BRUSH: <B> Cycle through draw brushes.
' CLEAR: <C> to clear the mask.
' FILE: <L> Load a mask from file (26 file-choices max)  <S> Save current mask
'       Note: the current mask is saved to a uniquely-named (time-based) file automatically.
' QUIT <Q> to exit program.
'==============================================================================    
#lang "fb"
#include "fbgfx.bi"
Using fb
Windowtitle "Simple FB Graphics Demo Series - MASK MAKER 8X8 CHARACTER SIZE"
'=============================================================================   
Randomize (Timer)
Const w= 800, h= 600
Screenres w, h, 8
Dim Shared As Integer rows = 75, cols = 100   
Width cols,rows
Dim Shared As Integer maskrows = 73, maskcols = 100
Dim Shared As Integer mx, my, mb, row, col,lastx1, lasty1, lastx2, lasty2
Dim Shared As Integer charw = 8 ,charh = 8, trow, tcol, cnt
Dim Shared As String tStr, tStr2, ch, tname, userloaded, selection
Dim Shared As String path
path = "" 'for current folder
'path = "Masks8x8\" 'for sub-folder, change as user wishes
Dim Shared As String *1 brush, cmd
Dim Shared As String *1 drawbrush = Chr(219)   
Const As String maskbrush = Chr(177)
Dim Shared brushes(0 To 3) As String * 1
brushes(0) = Chr$(219) : brushes(1) = Chr(176) : brushes(2) = Chr(177) : brushes(3) = Chr(178)
Dim Shared As Integer brushcolor, drawcolor = 11, maskcolor = 3, commentcolor = 14   
Dim Shared mask(maskrows, maskcols) As String   
Type linetype   
  x1 As Integer   
  y1 As Integer   
  x2 As Integer   
  y2 As Integer   
End Type   
Dim Shared lyne As linetype   
'==============================================================================    
Declare Sub DrawLine(lyn As linetype,brush As String, colr As Integer)
Declare Function GetFileName(path As String, pattern As String) As String
Declare Function TextDate() As String
Declare Function RndRange(lo As Integer, hi As Integer) As Integer
Declare Sub Comment(msg As String, clr As Integer = 14)
'==============================================================================    
' make an array matching screen mask pattern; print it   
Color maskcolor   
tStr = String(maskcols, maskbrush)
For row As Integer = 1 To maskrows
For col As Integer = 1 To maskcols   
  mask(row, col) = Mid(tStr, col, 1)   
  Locate row, col
  Print mask(row, col);   
Next   
Next
'------------------------------------------------------------------------------   
Dim As Integer state = 0 'prime the pump   

'Main loop through the states of the program   
Do
  'EXECUTE THE COMMAND   
  Select Case state   
    'QUIT CODE
    Case -1   
      Comment("Thanks for using MASK MAKER 8x8.  Goodbye...")
      Sleep 2000 : Cls: Sleep 500 : End
    'GET CMD 
    Case 0   
      'get the user command   
      Comment("SHOWCMD")
      Do Until state <> 0
        Sleep 1
        cmd = Ucase(inkey)   
        If cmd <> "" Then   
          Select Case cmd   
           Case "D"   
              'DRAW   
              state = 1   
            Case "L"   
              'LINE   
              state = 2   
            Case "B"   
              'BRUSH   
              state = 3  
            Case "F"   
              'LOAD OR SAVE   
              state = 4 
            Case "C"   
              'CLEAR CANVAS   
              state = 5   
            Case "Q"   
              'QUIT
              state = 6
            Case Else   
              state = 0   
          End Select   
        End If 'cmd not empty 
      Loop ' Until state <> 0

    'EXECUTE CMD
    Case 1
      'DRAW CMD   
      Comment("DRAW: Left-click/drag  ERASE: R-click/drag  EXIT-DRAW: <ESC>")
      Do
        Sleep 1  
        If Multikey(sc_escape) Then state = 0 : Exit Do
        Getmouse mx, my,,mb 'get mouse info
        row = my\charh+1 : col = mx\charw+1
        Locate rows-1,1 : Color 15 :  Print "" & row & " " & col & "     "
        If row > 0 And row <= maskrows And col > 0 And col <= maskcols Then   
          Select Case mb   
            Case 1   
              brush = drawbrush
              mask(row, col) = brush
              Color drawcolor
              Locate row, col
              Print brush;   
            Case 2   
              brush = maskbrush
              mask(row, col) = brush
              Color maskcolor
              Locate row, col
              Print brush;   
          End Select
        End If   
      Loop
    Case 2   
      'LINE CMD   
      state = 0   
      Do
        While mb = 1 Or mb = 2 : Getmouse mx, my,,mb : Wend 'clear mouse
        Comment("LINE...LEFT-click on line-start - <U> UNDO - EXIT-LINE: <ESC>",15)
        While Not (mb = 1 Or mb = 2) 'get mouse info
          Sleep 1
          If Multikey(sc_escape) Then Exit Do
          If Multikey(sc_U) Then
            'UNDO LAST LINE
            If lastx1 <> 0 Then 'data available for undo-line  
              lyne.x1 = lastx1 : lyne.y1 = lasty1 : lyne.x2 = lastx2 : lyne.y2 = lasty2
              brush = maskbrush : brushcolor = maskcolor
              DrawLine(lyne, brush, brushcolor)
              lastx1 = 0 : lasty1 = 0 :lastx2 = 0 : lasty2 = 0
            End If
          End If
          Getmouse mx, my,,mb
          row = my\charh+1 : col = mx\charw+1
          Locate rows-1,1 : Color 15 :  Print "" & row & " " & col & "     "
          trow = my : tcol = mx
        Wend
        row = my : col = mx
        'first click sets either drawbrush or maskbrush
        brush = drawbrush : brushcolor = drawcolor
        If mb = 2 Then
          brush = maskbrush : brushcolor = maskcolor
        End If
        If row > -1 And row < h And col > -1 And col <w Then
          While mb = 1 Or mb = 2 : Getmouse mx, my,,mb : Wend 'clear mouse
          Comment("LINE...click on line-end",14)
          While Not (mb = 1 Or mb = 2) 'get mouse info
            Sleep 1
            If Multikey(sc_escape) Then Exit Do
            Getmouse mx, my,,mb
            row = my\charh+1 : col = mx\charw+1
            Locate rows-1,1 : Color 15 :  Print "" & row & " " & col & "     "
          Wend
          row = my : col = mx
          If row > -1 And row < h And col > -1 And col <w Then   
            lyne.x1 = tcol : lyne.y1 = trow
            lyne.x2 = col: lyne.y2 = row   
            lastx1 = lyne.x1 : lasty1 = lyne.y1 'for undo
            lastx2 = lyne.x2 : lasty2 = lyne.y2 'for undo
            DrawLine(lyne, brush, brushcolor)
          End If   
        End If
      Loop
    Case 3
      'BRUSH CMD
      state = 0 : cnt = 0
      Do
        Comment("CHANGE BRUSH - Press 'B' to cycle through brushes  - <ESC> to exit CHANGE BRUSH")
        tStr = ""
        While tStr <> "B" And tStr <> Chr(27) : tStr = Ucase(inkey) : Sleep 1 : Wend
        If tStr = Chr(27) Then Exit Select
        cnt +=1 : If cnt > Ubound(brushes) Then cnt = 0
        drawbrush = brushes(cnt)
        Comment("Current brush is: Brush #" & cnt & " Chr(" & Asc(drawbrush) & ")") : Sleep 2000
      Loop
    Case 4
      state = 0
      'LOAD/SAVE CMD
      Comment("COMMANDS:  <L> LOAD MASK - <S> SAVE MASK - EXIT: <ESC>")
      While tStr <> "L" And tStr <> "S" And tStr <> Chr(27) : tStr=Ucase(inkey) : Wend
      If tStr = Chr(27) Then
        Exit Select
      Else
        Select Case tStr
          Case "S"
            'SAVE MASK ARRAY AS A BASIC DATA STATMENT LIST  
            Comment("Saving mask...") : Sleep 500
            tname = "MASK_8X8_" & TextDate() & ".BI"
            Open path & tname For Output As #1   
            tStr = "DATA " + Chr(34)   
            For row As Integer = 1 To maskrows   
              tStr2 = tStr   
              For col As Integer = 1 To maskcols   
                tStr2 &= mask(row, col)   
              Next   
              tStr2 &= Chr(34)   
              Print #1, tStr2
            Next   
            Print #1, "DATA " & Chr(34) & "enddata" & Chr(34)
            Close #1   
            Sleep 10   
            Comment("The file " & tname & " has been saved")   
            Sleep 2500
          Case "L"
            selection = GetFileName(path, "*.bi")
            If selection <> "" Then
              'we now have the filename'
              Cls
              row = 0
              Open path + selection For Input As #1
              Line Input #1, tStr
              Do Until Instr(tStr,"enddata")
                row += 1
                tStr = Mid(tStr,7,Len(tStr)-7)
                For col = 1 To maskcols
                  mask(row,col) = Mid(tStr,col,1)
                  Color maskcolor
                  If mask(row,col) <> maskbrush Then Color drawcolor
                  Locate row,col : Print mask(row,col);
                Next
                Line Input #1, tStr
              Loop
              Close #1
              userloaded = selection
            End If
        End Select
      End If
    Case 5
      state = 0
      'CLEAR CANVAS  
      Comment("Clearing canvas...")
      ' make an array matching screen mask pattern; print it   
      Color maskcolor   
      tStr = String(maskcols, maskbrush)
      For row As Integer = 1 To maskrows
      For col As Integer = 1 To maskcols   
        mask(row, col) = Mid(tStr, col, 1)   
        Locate row, col
        Print mask(row, col);   
      Next   
      Next
      Sleep 2500
    Case 6
      'QUIT
      state = -1
    Case Else   
      state = 0
  End Select   

Loop 'MAIN LOOP   
End   
'==============================================================================
Sub Comment(msg As String, clr As Integer = 14)
  If Len(msg) = 0 Then msg = " "   
  If msg = "SHOWCMD" Then   
    msg = "<D>-Draw  <L>-Line  <B>-Brush  <C>-Clear canvas  <F>-Load/Save  <Q>-Quit (No Save)"   
  End If   
  Locate rows,1 : Print Space(cols-2); 
  Locate rows,(cols-Len(msg))\2 : Color clr : Print msg;
End Sub
'==============================================================================
Function TextDate() As String
  'Returns formatted date and time string, good for filenames
  Dim As String dateStr = date, timeStr = Time
  'Needed for Date for sorting filenames in ascending order
  dateStr = Right(dateStr,4) & "-" & Left(dateStr,3) & Mid(dateStr,4,2)
  'Needed for Time because files with colons in name not saved
  For i As Integer = 1 To Len(timeStr)
    If Mid(timeStr,i,1) = ":" Then Mid(timeStr,i,1) = "-"
  Next
  Return dateStr & "_" & timeStr
End Function
'==============================================================================
Sub DrawLine(lyn As linetype,brush As String, colr As Integer)
  'Bresenham's algorithm
  Dim As Integer x = lyn.x1, y = lyn.y1
  Dim As Integer dx =  Abs(lyn.x2-x), sx = Iif(x < lyn.x2, 1, -1)
  Dim As Integer dy = -Abs(lyn.y2-y), sy = Iif(y < lyn.y2, 1, -1)
  Dim As Integer e1 = dx+dy, e2 'Error value
  Do
    row =y\charh+1 : col = x\charw+1
    mask(row,col) = brush    
    Locate row,col: Color colr
    Print brush;
    If x = lyn.x2 And y = lyn.y2 Then Return
    e2 = 2 * e1
    If (e2 >= dy) Then e1 += dy : x += sx
    If (e2 <= dx) Then e1 += dx : y += sy
  Loop

End Sub
'==============================================================================
Function GetFileName(path As String, pattern As String) As String
  'Up to 26 files listed
  'Called with: res = GetFileName(path, pattern)
  'Pattern examples: "*.txt" or "Series*.bas"
  pattern &= " /B"
  Dim As String doscmd = "DIR " & path & pattern & " > " & path & "temp.lst"
  Shell doscmd
  Dim As String tStr, selection
  Dim As String * 1 alph
  alph = "A"
  ReDim As String names(0)
  Dim As Integer fn = Freefile
  
  Cls
  Locate 1, 1: Color 11
  Print "                               FILES LIST"
  Print "    Choose the file letter from among the files listed (max 26 files)"
  Print
  Open path + "temp.lst" For Input As #fn
  If Eof(fn) Then
    Print "NO FILES.. exiting" : Return ""
  Else
    Do Until Eof(fn) Or alph = "Z"
      Line Input #fn, tStr
      ReDim Preserve names(Ubound(names) + 1)
      names(Ubound(names)) = tStr
      Print "  " + alph + " " + tStr
      alph = Chr(Asc(alph)+1)
    Loop
  End If
  Close #fn
  Kill path + "temp.lst" ' Delete the file list file
  selection = "" : tStr = ""
  Do
    While Not ((tStr >= "A" And tStr <= alph) Or tStr = Chr(27)) : tStr = Ucase(inkey) : Wend
    If tStr = Chr(27) Then Exit Do
    selection = names((Asc(tStr)-Asc("A"))+1) : Exit Do
  Loop
  If selection <> "" Then Return selection
End Function
'=============================================================================
Top
Post Reply

Return to “Sources, Examples, Tips and Tricks”