Not a solution for you (windows) but maybe an inspiration (also for creating more console apps)...
Code: Select all
; Define 500 lines of code
EnableExplicit
#Q=#DOUBLEQUOTE$
#Shades=4
#ConsoleTitle="Console Clock by Michael Vogel"
Global Dim Pattern(#Shades)
Structure CharType
Width.i
Height.i
Space.i
DotWidth.i
Bytes.i
OffsetX.i[5]
OffsetY.i
Dot.i
TimeDot.i
Time.i[5]
OldTime.i[5]
Transition.i[2]
Phase.i[2]
ColorMode.i
Foreground.i
Background.i
ConsoleColors.i
Delay.i
Running.i
Refresh.i
FontFace.s
FontType.i
FontRatio.i
ClearOnExit.i
Countdown.i
StopAtZero.i
TimerDone.i
FullChar.i
MidChar.i
HalfChar.i
TimeFormat.s
TimeOffset.i
CpuTime.i
EndStructure
Structure ConsoleType
Handle.i
Width.i
Height.i
Cursor.i
Background.i
Window.i
EndStructure
Global Dim Matrix.b(11,10)
Global Char.CharType
Global Con.ConsoleType
Structure Console_COORD
StructureUnion
coord.COORD
long.l
EndStructureUnion
EndStructure
; EndDefine
Procedure Max(a,b)
If a>b
ProcedureReturn a
Else
ProcedureReturn b
EndIf
EndProcedure
Procedure Limit(value,min,max)
If value>max
ProcedureReturn max
ElseIf value<min
ProcedureReturn min
Else
ProcedureReturn value
EndIf
EndProcedure
Procedure Check(check,yes,no)
If check
ProcedureReturn yes
Else
ProcedureReturn no
EndIf
EndProcedure
Procedure ConsoleBufferLocate(x,y)
Protected Coordinates.Console_COORD
Coordinates\coord\x=x
Coordinates\coord\y=y
SetConsoleCursorPosition_(Con\Handle,Coordinates\long)
EndProcedure
Procedure ConsoleClear()
Protected Coordinates.Console_COORD
Protected NumberOfCharsWritten
Coordinates\coord\x=0
Coordinates\coord\y=0
FillConsoleOutputCharacter_(Con\Handle,' ',Con\Height*Con\Width,Coordinates\long,@NumberOfCharsWritten)
FillConsoleOutputAttribute_(Con\Handle,Con\Background+Char\Foreground,Con\Height*Con\Width,Coordinates\long,@NumberOfCharsWritten)
ConsoleBufferLocate(0,0)
EndProcedure
Procedure ConsoleBackground(color)
ProcedureReturn (#BACKGROUND_BLUE*Bool(color&1)) | (#BACKGROUND_GREEN*Bool(color&2)) | (#BACKGROUND_RED*Bool(color&4)) | (#BACKGROUND_INTENSITY*Bool(color&8))
EndProcedure
Procedure CreateFont()
Protected.f cw,ch,fw,fh,mx,my,ox,oy,px,py
Protected.i i,xmin,xmax,ymin,ymax,z
Protected.i n,w,o,ix,iy
Protected.s s
fw=200
fh=200
xmin=9999
ymin=9999
For i=0 To 10
s=Chr('0'+i)
CreateImage(i,fw+50,fh,32,#White)
StartVectorDrawing(ImageVectorOutput(i))
VectorFont(FontID(0),100)
If i=0
fw=VectorTextWidth(s,#PB_VectorText_Default)
fh=VectorTextHeight(s,#PB_VectorText_Default)
EndIf
cw=VectorTextWidth(s,#PB_VectorText_Visible)
ch=VectorTextHeight(s,#PB_VectorText_Visible)
ox=VectorTextWidth(s,#PB_VectorText_Visible|#PB_VectorText_Offset)
oy=VectorTextHeight(s,#PB_VectorText_Visible|#PB_VectorText_Offset)
mx=(fw-cw)/2
my=(fh-ch)/2
z=Round(mx,#PB_Round_Down) : If xmin>z : xmin=z : EndIf :
z=Round(mx+cw,#PB_Round_Up) : If xmax<z : xmax=z : EndIf :
z=Round(my,#PB_Round_Down) : If ymin>z : ymin=z : EndIf :
z=Round(my+ch,#PB_Round_Up) : If ymax<z : ymax=z : EndIf :
MovePathCursor(25+mx-ox,my-oy)
DrawVectorText(s)
StopVectorDrawing()
If i=0
GrabImage(0,0,0,0,fw+50,fh)
EndIf
Next i
For i=0 To 10
GrabImage(i,i,25+xmin,ymin,xmax-xmin,ymax-ymin)
ResizeImage(i,Char\Width,Char\Height,#PB_Image_Smooth)
Next i
Char\DotWidth=cw*Char\Width/(xmax-xmin)
Char\Bytes=Char\Width*Char\Height
ReDim Matrix(11,Char\Bytes)
w=Char\Width
For i=0 To 10
If i=10
w=Char\DotWidth
o=(Char\Width-w)/2
EndIf
StartDrawing(ImageOutput(i))
n=0
iy=0
While iy<Char\Height
ix=0
While ix<w
z=($FF-(Point(o+ix,iy)&$FF))*#Shades/255
Matrix(i,n)=Round(z,#PB_Round_Nearest)
n+1
ix+1
Wend
iy+1
Wend
StopDrawing()
FreeImage(i)
Next i
EndProcedure
Procedure DrawChar(index)
Protected i,j,n,w,c,o,p
Protected x,y,pt,pc,po
x=Char\OffsetX[index]
y=Char\OffsetY
c=Char\Time[index]
o=Char\OldTime[index]
i=Bool(index)
pt=Char\Transition[i]
po=Char\Phase[i]
pc=pt-po
While j<Char\Height
ConsoleBufferLocate(x,y+j)
i=0
If c>=10
w=Char\DotWidth
Else
w=Char\Width
EndIf
While i<w
If pc And pt And c<>o
p=(Matrix(c,n)*pc+Matrix(o,n)*po)/pt
p=Pattern(p)
Else
p=Pattern(Matrix(c,n))
EndIf
If Char\ColorMode
Print(Chr(p))
Else
ConsoleColor(#Null,p)
Print(" ")
EndIf
n+1
i+1
Wend
j+1
Wend
EndProcedure
Procedure Main()
Protected i,j,e
Protected.s s,t
Protected ConsoleBufferInfo.CONSOLE_SCREEN_BUFFER_INFO
With Char
\FontFace= "Bahnschrift"
\FontType= #PB_Font_HighQuality
\FontRatio= 5
\Foreground= 7
\Background= 0
\HalfChar= 'o'
\MidChar= '@'
\FullChar= '@'
\Transition[0]= 0
\Transition[1]= 0
\Delay=95
\TimeFormat="%hh%ii"
j=CountProgramParameters()
While i<j And e=0
s=ProgramParameter(i)
i+1
t=Trim(Mid(s,3+Bool(Mid(s,3,1)=":")),#Q)
If Left(s,1)="/"
Select PeekC(@s+SizeOf(Character))|$20
Case 'f'
\FontFace=t
Case 't'
t=LCase(t)
If FindString(t,"b") : \FontType|#PB_Font_Bold : EndIf
If FindString(t,"i") : \FontType|#PB_Font_Italic : EndIf
Case 'c'
\Foreground=Limit(Val(t),0,15)
\Background=Limit(Val(StringField(t,2,",")),0,15)
Case 'a'
\Transition[1]=Limit(Val(t),0,10)
t=StringField(t,2,",")
If t
\Transition[0]=Limit(Val(t),0,10)
Else
\Transition[0]=\Transition[1]
EndIf
Case 'd'
\Delay=Limit(Val(t),1,10)*10-5
Case 'h'
\FontRatio=Limit(Val(t),0,10)
Case 'z'
\ClearOnExit=#True
Case 'm'
\TimeFormat="%ii%ss"
If t
i=Val(t)
If i<0
i=-i
\StopAtZero=#True
EndIf
\TimeOffset=Date()+i;*60
\Countdown=Bool(i)
EndIf
Case 's'
If t=""
\FullChar='®'
\MidChar='o'
\HalfChar='·'
Else
\FullChar=Asc(t)
\HalfChar=Asc(StringField(t,2,","))
\MidChar=Asc(StringField(t,3,","))
If \HalfChar=0 : \HalfChar=\FullChar : EndIf
If \MidChar=0 : \MidChar=\FullChar : EndIf
EndIf
Case '?'
e=#True
EndSelect
Else
e=#True<<#True
EndIf
Wend
If e
OpenConsole()
PrintN("")
PrintN(#ConsoleTitle)
PrintN("------------------------------")
If e=1
PrintN("/f:font font name")
PrintN("/h:0-10 font height")
PrintN("/t:[b][i] font type")
PrintN("/c:0-15[,0-15] color mode")
PrintN("/a:0-10[,0-10] animation")
PrintN("/d:0-10 delay")
PrintN("/s:char[,...] text symbols")
PrintN("/m[:time] timer mode")
PrintN("/z clear screen")
;Input()
Else
PrintN("Illegal parameter '"+s+"'.")
EndIf
End
EndIf
LoadFont(0,\FontFace,100,\FontType)
Con\Background=ConsoleBackground(\Background)
\ColorMode=Bool(\Foreground<>\Background)
OpenConsole(#ConsoleTitle)
Con\Handle=GetStdHandle_(#STD_OUTPUT_HANDLE)
ConsoleClear()
If \ColorMode
Pattern(0)=' '
Pattern(1)=\HalfChar
Pattern(2)=\MidChar
Pattern(3)=\FullChar
Pattern(4)=\FullChar
Else
Pattern(0)=\Background
i=Bool(\Background<8)
If Bool(\Background%15)
j=\Background+(i<<4)-8
Pattern(1)=j
Pattern(2)=j
Else
Pattern(1)=check(i,8,7)
Pattern(2)=15-Pattern(1)
EndIf
Pattern(3)=check(i,15,0)
Pattern(4)=Pattern(3)
EndIf
ConsoleCursor(0)
ConsoleColor(\Foreground,\Background)
\Refresh=#True
; ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~
CompilerIf #PB_Compiler_Debugger
Debug "Compile as console app"
Debug "Try 'clock /m:45 /a:10'..."
\Transition[0]=8
\Transition[1]=10
\TimeOffset=Date()+45;*60
\TimeFormat="%ii%ss%ss"
\StopAtZero=#True
\Countdown=#True
CompilerEndIf
; ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~
Repeat
\CpuTime=ElapsedMilliseconds()
GetConsoleScreenBufferInfo_(Con\Handle,@ConsoleBufferInfo)
i=Max(ConsoleBufferInfo\srWindow\right-ConsoleBufferInfo\srWindow\left+1,10)
j=Max(ConsoleBufferInfo\srWindow\bottom-ConsoleBufferInfo\srWindow\top+1,4)
If i<>Con\Width Or j<>Con\Height
Con\Width=i
Con\Height=j
\Space=Round(Con\Width*0.02,#PB_Round_Up)
\Width=(Con\Width-\Space*6)*0.23
\Height=Con\Height*(10+\FontRatio)/20
CreateFont()
\OffsetX[1]=Char\Space
\OffsetX[2]=Char\Width+Char\Space*2
\OffsetX[0]=\OffsetX[2]+Char\Width+Char\Space
\OffsetX[3]=\OffsetX[0]+Char\DotWidth+Char\Space
\OffsetX[4]=\OffsetX[3]+Char\Width+Char\Space
\OffsetY=(Con\Height-\Height)/2
j=(Con\Width-\OffsetX[4]-\Width-\Space)/2
If j
For i=0 To 4
\OffsetX[i]+j
Next i
EndIf
\Refresh=#True
ConsoleClear()
EndIf
i=Date()
j=i-\TimeOffset
If \Countdown
If j=0
\TimerDone|#True
ElseIf j<0
j=-j
ElseIf \StopAtZero
j=0
EndIf
EndIf
s=FormatDate(\TimeFormat,j)+FormatDate("%ss",i)
If Char\Running
If Bool(i%10<>\TimeDot)
\TimeDot=i%10
Char\OldTime[0]=Char\Time[0]
Char\Time[0]=i&1+10
Char\Phase[0]=Char\Transition[0]
\Refresh=#True
If \TimerDone=1
\TimerDone|2
ConsoleColor(12,\Background)
EndIf
EndIf
i=Asc(Mid(s,4,1))-'0'
If i<>Char\Time[4] Or Char\Running=1
Char\Running=2
For i=1 To 4
Char\OldTime[i]=Char\Time[i]
Char\Time[i]=Asc(Mid(s,i,1))-'0'
Next
Char\Phase[1]=Char\Transition[1]
EndIf
If Char\Phase[0] Or \Refresh
Char\Phase[0]=Max(Char\Phase[0]-1,0)
DrawChar(0)
EndIf
If Char\Phase[1] Or \Refresh
Char\Phase[1]=Max(Char\Phase[1]-1,0)
For i=1 To 4
DrawChar(i)
Next i
EndIf
\Refresh=#Null
Else
Char\Time[0]=(Asc(Mid(s,6,1))&1)+10
Char\OldTime[0]=Char\Time[0]!1
For i=1 To 4
Char\Time[i]=11
Next
Char\Running=#True
EndIf
Delay(\Delay+Max(\CpuTime-ElapsedMilliseconds(),1-\Delay))
Until Inkey()<>""
ConsoleColor(7,0)
ConsoleCursor(1)
If \ClearOnExit
Con\Background=ConsoleBackground(\Background)
ConsoleClear()
Else
PrintN("")
EndIf
EndWith
EndProcedure
Main()
