Основной код:
Библиотека CreaFicheroDigitos.yab
Библиотека image.yab
Результат работы (тормозит само gif изображение, не программа):
Код: Выделить всё
#!/usr/bin/yabasic
rem Program Name: DigitosLuminosos.yab
rem Author: Galileo, 4/2014
rem
rem Purpose: Ejemplo de utilización de dígitos luminosos
rem Imágenes de los números tomados de un programa en X11-Basic
dim digitos$(10)
clear screen
open window 320, 240
backcolor 0,0,0
clear window
open "DigitosLuminosos" for reading as #1
for n = 0 to 10
line input #1 digitos$(n)
next n
close #1
fecha$ = mid$(date$,6,2)+":"+mid$(date$,3,2)+":"+mid$(date$,9,4)
muestra(fecha$, 100, 100)
repeat
muestra(left$(time$,8), 10, 10)
until(inkey$(.1) = "esc")
sub muestra(s$, x, y, e)
local largo, n, pos, patron$, coord
patron$ = "0123456789:"
largo = len(s$)
for n = 1 to largo
pos = instr(patron$,mid$(s$,n,1))
if pos = 0 pos = 11
putbit digitos$(pos-1),x,y
if pos < 11 then
x = x + 23
else
x = x + 10
end if
next n
end sub
Код: Выделить всё
#!/usr/bin/yabasic
rem Program Name: CreaDigitos.yab
rem Author: Galileo, 4/2014
rem
rem Purpose: Crea el fichero con los digitos
rem Digitos: 23 x 33
rem Dos puntos: 10 x 33
import image
dim digitos$(10)
clear screen
open window 242, 35
GetImage(1, "DigitosLuminosos.bmp")
DisplayImage(1,0,0)
inkey$
for n = 1 to 9
digitos$(n) = getbit$((n-1)*23+1,1 to n*23,33)
next n
digitos$(0) = getbit$((n-1)*23+1,1 to n*23,33)
n = n + 1
digitos$(10) = getbit$((n-1)*23+1,1 to (n-1)*23+10,33)
open "DigitosLuminosos" for writing as #1
for n = 0 to 10
print #1 digitos$(n)
next n
close #1
close window
print "Se ha generado el fichero con los digitos luminosos.\nPulse cualquier tecla para terminar."
inkey$
exit
Код: Выделить всё
doc Library image.yab, routines for handling images in several formats
doc programmed by Hermang Hialino Mansilla Mattos, hh_mm@yahoo.com
doc last modified on May 30, 2006
doc graphic formats supported: 8bit pcx, bmp and 24bit bmp
doc it detects the format based on the filename extension or file's header
doc Useful routines:
doc err=GetImage( index , filename$ )
doc DrawImage( index , dx,dy )
doc from the main program you can change the variable image.Path$
rem import gif
rem ==========================================
Path$ = "" : rem path from where to load images
Error$ = ""
ValidExt$ = "bmp,pcx,lss,gif,bin" : rem soon gif, jpg, xbm, xpm
mp = 32
Dim Filename$(mp), Ext$(mp)
Dim Widths(mp), Heights(mp), bpps(mp)
Dim Offsets(mp)
Offset = 0
Width = 0
Height = 0
bpp = 0
Dim Palette(256*4)
sub GetExt$(filename$)
local i
i = rinstr(filename$, ".")
if i > 0 then
i = len(filename$) - i
return(lower$(right$(filename$, i)))
else
return ""
end if
end sub
Export sub GetImage(index, filename$)
local fp, ext$
if index < 0 and index > mp then
Error$ = "invalid index"
return -1
end if
ext$ = GetExt$(filename$)
if instr(ValidExt$, ext$) then
fp = open( Path$+filename$ , "rb" )
if fp < 1 then
Error$ = "File "+filename$+" Does not Exist in path "+Path$
return -1
end if
Filename$(index) = Path$+filename$
Ext$(index) = ext$
close(fp)
else
Error$ = "La extensión '"+ext$+"' no es válida."
return -1
end if
return 1
end sub
Export sub DisplayImage(index, dx , dy)
rem only bmps for now
if Ext$(index) = "bmp" DrawBMP(Filename$(index),dx,dy)
if Ext$(index) = "pcx" DrawPCX(Filename$(index),dx,dy)
rem Work in Progress :
if Ext$(index) = "lss" DrawLSS(Filename$(index),dx,dy)
if Ext$(index) = "gif" DrawGIF(Filename$(index),dx,dy)
end sub
Export sub DrawImage(fn$, dx, dy)
tmp = GetImage(0, fn$)
DisplayImage(0, dx, dy)
end sub
Sub Report()
? "ImageWidth = " , Width
? "ImageHeight = " , Height
? "BitsPerPixel=" , bpp
? "ImageOffset = " , Offset
rem ? "FileSize = " , FileSize
? "Last Error = ", Error$
End Sub
export sub DrawBMP( bmpfile$, dx,dy )
local fp, k, row, col, byte, blue, green
Error$=""
fp = open(bmpfile$,"rb")
if fp < 1 then
Error$ = "File "+bmpfile$+" Does not Exist"
return -1
end if
rem seek #fp,2
rem FileSize=peek(fp)+256*peek(fp)+65536*(peek(fp)+256*peek(fp))
seek #fp,10 : Offset = peek(fp)+256*peek(fp)
seek #fp,18 : Width = peek(fp)+256*peek(fp)
seek #fp,22 : Height = peek(fp)+256*peek(fp)
seek #fp,28
bpp = peek(fp)
IF bpp = 8 THEN
rem Read the Color Palette of 8bit BMP file already opened
rem loads color values and stores them in Palette()
rem values start at byte 55 in the file. Four bytes are stored
rem for each color, three for the blue, green and red values
rem and one which is not used.
seek #fp,55-1
for c = 0 to 1023
Palette(c) = peek(fp)
next c
seek #fp,Offset
for row = 1 to Height
FOR col = 1 to Width
byte = 4*peek(fp)
color Palette(byte+2),Palette(byte+1),Palette(byte)
dot dx+col,dy+Height+1-row
NEXT col
rem adjust extra bytes
c = Width
while(mod(c,4)<>0)
tmp = peek(fp)
c = c+1
wend
next row
ELSIF bpp = 24 THEN
seek #fp,54
for row = 1 to Height
FOR col = 1 to Width
blue = peek(fp)
green = peek(fp)
color peek(fp),green,blue
dot dx+col,dy+Height+1-row
NEXT col
rem adjust extra bytes
c = Width*3
while(mod(c,4)<>0)
tmp = peek(fp)
c = c+1
wend
next row
END IF
close fp
end sub
Export Sub DrawPCX(pcxfile$, dx, dy )
local fp, i, flength
local x, y, idx, pix, rle, debug
fp = open(pcxfile$,"rb")
seek #fp, 8
Width = peek(fp)+256*peek(fp)
Height = peek(fp)+256*peek(fp)
REM ************ GO TO END TO CHECK FILESIZE AND READ PALETTE *******
seek #fp, 0, "end"
flength = tell(#fp)
seek #fp, -768 ,"end"
for i = 0 to 767
Palette(i) = peek(#fp)
next i
REM ************ READ Run Length Encoded Pixel Data ********
seek #fp, 128
rem for i = 0 to flength-128-768
rem rle(i) = peek(#fp)
rem next i
idx = 0
for y = 0 to Height
x = 0
while(x <= Width)
pix = peek(#fp)
if pix > 192 then
rle = pix-192
pix = 3*peek(#fp)
color Palette(pix), Palette(pix+1), Palette(pix+2)
if x+rle > Width+1 then
line dx+x,dy+y to dx+Width, dy+y
y = y+1
x = x+rle-Width-1
line dx,dy+y to dx+x,dy+y
else
line dx+x,dy+y to dx+x+rle,dy+y
x = x+rle
end if
else
color Palette(3*pix), Palette(3*pix+1), Palette(3*pix+2)
dot dx+x,dy+y
x = x+1
end if
wend
next y
close(fp)
End Sub : rem DrawPCX()
rem ========================================
sub DrawGIF()
rem not ready yet !
end sub
sub DrawLSS()
rem not ready yet !
end sub
Результат работы (тормозит само gif изображение, не программа):